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I.  Introduction,  Summary,  and  Examples 
A.  Introduction 

The  usual  spectral  analysis  is  an  examination  of 
the  second-order  properties  of  a  time  series.  The  spec¬ 
trum  is,  in  fact,  a  description  of  how  the  various  fre¬ 
quency  bands  contribute  to  the  variance  (the  second  moment) 
of  the  series,  or  the  covariance  in  the  case  of  cross¬ 
spectra.  If  the  time  series  is  a  record  from  a  Gaussian 
process,  then  the  second-order  spectrum  provides  a 
"complete"  description  because  all  higher  moments  of  the 
series  (for  example  the  third  moment,  skewness,  or  the 
fourth  moment,  Kurtosis)  are  either  zero  or  representable 
in  terms  of  the  second  moment.  One  particular  feature  of 
stationary  Gaussian  processes  is  that  the  individual  fre¬ 
quency  components  are  independent;  second-order  spectral 
analysis  is  consistent  with  this  feature,  in  that  nothing 
in  the  analysis  is  sensitive  to  any  non-independence  of 
frequency  components. 

But  phase-locking  of  frequency  components  is  a  sig¬ 
nificant  feature  of  numerous  important  processes.  For  in¬ 
stance,  spectral  lines  may  show  up  at  some  frequency  and  at 
twice  that  frequency;  second-order  spectral  analysis  can 
only  detect  the  existence  of  the  lines,  but  an  analysis 
-  that  can  detect  whether  the  two  lines  are  phase-locked  can 
tell  if  the  higher- frequency  line  is  simply  the  first  har¬ 
monic  of  the  lower-frequency  line.  A  common  example  would 
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be  lines  at  0.08  and  0.16  cph;  the  first  is  probably  the 
tide,  but  is  the  second  the  tide  or  the  first  har¬ 
monic  of  the  M2  tide?  A  less  common  example  would  be 
quadratic  nonlinear  interactions,  in  which  the  product  of 
frequency  components  at  and  would  give  rise  to  a 
phase-locked  frequency  component  at  where 

(i)l  +  0)2  -  W3  =  0.  This  is  analogous  to  the  usual  spectral 
analysis  in  which  only  two  frequency  components  contribute 
to  the  energy,  such  that  +  0)2  =  0;  this  is  usually 
written  as  W2  =  and  interpreted  as  the  energy  being 

due  to  the  frequency  components  at  ±03^. 

Thus  the  bispectrum  is  a  third-order  spectrum 

(c.f.,  Hasselman,  Munk,  and  McDonald,  1963;^  Nagata, 

2  3  4 

1970;  Yao,  Neshyba,  and  Crew,  1975  and  1977;  and 

5 

Haubrich,  1965  )  that  is  sensitive  to  phase-locked  fre¬ 
quency  triplets,  such  that  +  CO2  ~  =  0.  Because  only 

(D^  and  032  need  be  mentioned  (03^  =  03^^  +  032  always)  ,  the 
pair  (03^,032)  is  referred  to  as  a  bi-frequency,  and  the 
display  of  the  bispectrum  is  usually  in  terms  of  contours 
in  the  bi-frequency  plane. 

If  all  three  frequencies  from  the  triplet  (03^^,  032  / 
are  from  a  single  scalar  (real)  series,  it  is  becoming 
customary  to  refer  to  the  "auto-bispectrum,"  whereas  if 
the  three  frequencies  are  not  from  the  same  scalar  series, 
one  refers  to  the  "cross-bispectrum."  If  the  series  are 
not  scalar,  but  rather  vector  random  processes,  such  as 
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wind  or  ocean  current  velocity,  one  can  choose  a  method 
of  treating  the  vectors  developed  by  Yao  et  al.,  1975,-^ 
and  use  a  rotary  decomposition  of  the  vectors  that  is 
independent  of  the  rectangular  coordinate  system  that 
might  be  used,  and  which  is  particularly  useful  for  physical 
processes  involving  rotation.  In  this  case  one  refers  to 
"auto- rotary  bispectra,"  and  so  on. 

B.  Summary 

This  report  describes  a  series  of  computer  programs 
developed  at  Woods  Hole  Oceanographic  Institution  during 
1977  to  compute  scalar  bispectra  and  cross-bispectra 
(BISCAL) ,  rotary  bispectra  and  cross-rotary  bispectra 
(BIVEC)  and  to  display  corresponding  bicoherences  (BPLOT) 
and  rotary  bicoherences  (RBPLOT)  as  contour  plots  on  the 
bi-frequency  plane.*  The  usual  method  of  calculating  the 
bispectrum  in  the  frequency  domain  after  using  the  Fast 
Fourier  Transform  is  used  here,  and  so  there  is  a  program 
for  calculating  the  Fourier  coefficients  (FOURIER)  as  well 
as  programs  for  organizing  the  data  (FRAGTAP,  ORDAT)  or 
generating  artificial  series  (GENRAN)  if  desired.  There 
is  also  one  special-purpose  program  which  calculates  line 
integrals  of  (scalar)  bicoherences  in  the  bifrequency  plane 
along  paths  of  constant  0)3  =  +0)]^  +103  to  determine  the  rela¬ 
tive  total  contribution  of  quadratic  interactions  to  each 
frequency  (BISUM).  After  the  descriptions  of  these  programs, 

*See  pages  75-77  for  precise  definitions  of  the  bispectrum 
and  bicoherence. 
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there  is  a  collection  of  actual  FORTRAN-IV  listings  of 
them  arranged  alphabetically. 

C.  Examples  Based  on  Artificial  Signals 

Definition  of  "Hanning"  and  "Overlapping*' 

In  the  following  discussion,  the  terms  "Hanning"  and 
"overlapping"  are  used.  Hanning*  refers  to  a  particular 
data  window  applied  to  the  time  domain  in  order  to  reduce 
side  lobes  and  consequent  leakage  in  the  frequency  domain. 

The  window  is  a  "raised  cosine"  over  100  percent  of  the 
time  record;  many  windows  are  possible  and  some  are  more 
efficacious,  but  the  Hanning  window  is  extremely  efficient 
to  implement.  See  Reference  6  for  a  general  discussion  of 
windows . 

One  effect  of  windowing  is  to  lessen  the  effective 
length  of  the  time  domain  segment,  which  equivalently  re¬ 
duces  the  useful  degrees  of  freedom  in  the  segment.  This 
effect  is  compensable  by  segmenting  the  entire  time  domain 
record  into  overlapping  pieces  so  that  the  losses  due  to 
windowing  in  one  segment  are  recovered  in  the  overlapped 

n 

segment.  Nuttall  has  shown  that  62.5  percent  overlapping 
allows  a  complete  recovery  of  degrees-of-freedom  losses, 
but  that  50  percent  overlapping  is  much  simpler  and  yields 
a  92  percent  recovery  of  losses. 

The  computational  recipes  applied  here  are  as  follows: 

* "Hanning"  is  a  traditional  misnomer:  the  term  is  based 
on  the  name  of  Julius  Von  Hann,  who  first  described  the 
window,  by  analogy  to  Hamming,  which  is  another  window 
that  is  due  to  Richard  Hamming. 
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Let  a  series  consist  of  (2Tjj^)  points  spaced  at  a 

"time"  At  =  1  apart  so  that  the  Nyquist  frequency  is  (1/2) 

and  there  are  (T  +1)  spectral  estimates.  Let  u'  (t)  be 

^m 

the  Hanning  window  to  be  applied  at  time  t.  Then: 


m 


2  [1-cos  (^)] 
m 


T  <  0 


0  <  T  <  2  T 


m 


T  >  2  T 


m 


(1) 


The  Fourier  transform  of  u'  (t)  is  (f)  as  follows: 

■^m  "^m 


^T  ^T  ~  4^T  2T  ^  “  4^T  2T 

m  m  m  m  m  m 


(2) 


where  0  £  f  £  1/2  and  Af  =1/(2T^)  and  (f)  is  the  Fourier 

m 

transform  of  the  rectangular  window  of  unit  height  over  the 

time  2T  for  which  the  expression  (1)  is  nonzero- 
m 

By  the  convolution  theorem  the  application  of  expression 
(2)  to  the  Fourier  transformed  series  is  equivalent  to 
applying  (1)  to  the  original  series.  It  is  expression 
(2)  that  is  used  to  accomplish  Hanning  below.  Specifically, 
if  we  consider  a  real  series  of  n  points  having  the  follow¬ 
ing  Fourier  representation: 


n/2 

U.  =  a  +  y  [a,  cos  (27Tjk/n)  +  b,  sin  (2tt jk/n)  ]  , 

1  O  T  n  K  K 

k=l 
t  h 

then  the  i  Banned  coefficient  is: 


u:  =  0.5  U. 
1  1 


0.25(U^_^  + 
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The  Fourier  coefficients  through  ~  ^2 

through  ti^^2  2  changed  by  Hanning,  leaving  the  fol¬ 
lowing  unchanged:  a^,  ^1'  ^n/2-l‘ 

If  the  variance  of  the  Hanned  series  is  now  com¬ 
puted,  it  will  be  found  to  be  low  because  of  the  cosine 
taper.  To  correct  for  this,  the  transformed  and  Hanned 
series  can  be  multiplied  by  the  ratio  of  the  variance  of 
the  transformed,  non-Hanned,  series  to  the  variance  of 
the  transformed,  Hanned  series.  An  approximation  to 

this  value,  valid  for  a  sufficiently  large  number  of  data 

2 

pieces,  is  a  theoretical  value  for  Gaussian,  white  noise: 

/8/3 .  All  transformed  and  Hanned  series  in  this  report 

have  been  multiplied  by  /8/3 . 

In  calculating  the  power  spectrum  of  a  data  series, 

it  is  desirable  to  divide  the  series  into  segments,  and 

to  overlap  these  segments  when  using  a  data  or  spectral 

9 

window  such  as  the  Hanning  window  (Welch,  1967  ) .  The 
segmenting  is  desirable  for  many  reasons,  such  as  the  re¬ 
duction  in  the  series  length  to  be  transformed,  a  possible 
reduction  in  the  number  of  overall  computations,  greater 
ease  of  observing  nonstationary  trends  in  the  data,  and 
greater  control  over  frequency  resolution. 

Specifically,  for  a  50%  overlap,  let  the  number  of 
points  per  segment  or  "piece"  be  S.  If  the  pieces  are 
numbered  consecutively  i  =  1,2,...,  and  the  data  points  are 
numbered  consecutively  1 , 2  ,  then  the  i^^  piece  starts 
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at  point  [1+ (i-1) S/2] .  This  is  done  until  no  more  complete 
pieces  can  be  constructed  from  the  data,  the  remaining  data 
being  discarded  if  necessary.  Note  that  because  of  the 
Fast  Fourier  Transform  algorithm  used,  the  piece  length 
is  never  odd. 

All  real  (i.e.,  scalar)  series  or  real  components  of 
vector  series  to  be  used  below  consist  of  10  pieces  of 
length  64,  resulting  in  32  complex  Fourier  coefficients 
for  each  piece.  These  10  pieces'*  are  contiguous  in  the  case 
of  no  Hanning  and  no  overlapping,  meaning  that  640  points 
of  the  series  are  used.  For  Hanning  and  50%  overlapping, 
352  points  of  the  series  are  used. 

All  contour  plots  except  Figures  16  and  17  are  con¬ 
toured  at  the  80,  85,  90,  95,  and  99%  confidence  levels  de¬ 
termined  from  a  Gaussian  noise  background.*  Figures  16 
and  17  emphasize  the  bicoherence  peaks  by  displaying  con¬ 
tours  at  the  95,  96,  97,  98,  and  99%  confidence  levels. 

All  series  used  for  auto-  and  cross-bicoherence  plots  are 
Hanned  and  overlapped.  A  comparison  of  Hanning  with  no 
Hanning  is  given  in  the  demonstration  of  auto-rotary  bi¬ 
coherence  plots. 

See  page  7  in  program  BISCAL  report  below,  and 
pages  6,7  in  program  BWEC  below. 
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1.  Auto-bicoherence 

Figures  3,  4,  and  5  are  auto-bicoherence  contour  plots 
of  the  following  three  Hanned  artificial  signals:* 


Fig . 

3: 

s  =  g 

+ 

a  (cos 

8t  + 

COS 

16t  + 

COS 

24t) 

Fig . 

4; 

s  =  g 

+ 

a  (sin 

8t  + 

sin 

16t  + 

sin 

24t) 

Fig . 

5: 

s  =  g 

+ 

a  (-sin 

8t  - 

■  sin 

16t  - 

sin 

24t) 

In  all  three  cases,  g  is  Gaussian  noise  with  zero  mean  and 
unity  variance,  and  a  =  10.  Figure  3  uses  the  Gaussian 
noise  background  whose  auto-bicoherence  is  displayed  in 
Figure  1,  while  Figures  4  and  5  both  use  the  Gaussian  noise 
background  having  the  auto-bicoherence  shown  in  Figure  2. 

It  is  observed  that  all  three  figures  are  essentially  alike, 
with  two  peaks  at  the  only  possible  coupled  frequency  trip¬ 
lets  ((jOj^  ,  0)2  /  ^3)  • 

(o)j^,  0)2,  0)^)  =  (8,  8,  16)  and  (8,  16,  24)  . 

Note  that  oj^  is  the  horizontal  intercept  of  the  straight 
line  0)2  =  -0)^  +  0)^  [i.e.,  o)^  +  0)2  ~  having  slope 

(-1)  and  passing  through  the  bi-frequency  (o)^,a)2)  •  The 
contour  plots  are  alike  because  the  signals  differ  only  in 
the  phasing  of  the  terms  and  the  bicoherence  does  not  give 
any  phase  information. 


*In  generating  all  of  the  artificial  series  used  in  this 
report,  an  error  in  indexing  in  program  GENRAN  intro¬ 
duced  into  each  sinusoidal  term  an  additional  phase 
angle  of  (-27To)/L)  ,  where  o)  =  frequency  and  L  =  piece 
length.  Since  this  made  no  difference  in  the  appearance 
or  interpretation  of  the  plots,  the  examples  presented 
were  not  repeated. 


Now  notice  that  if  Figures  3  and  4  were  presented  as 
the  "east"  and  "north"  components  of  velocity,  for  example, 
they  would  be  representing  three  coupled  counterclockwise 
rotating  vectors  of  frequencies  8,  16,  and  24.  If  Figures 
3  and  5  were  so  presented,  they  would  be  representing  three 
coupled  clockwise  rotating  vectors.  Since  the  pairs  of  figures 
are  identical,  could  one  detect  the  presence  of  these 
coupled  rotating  vectors?  In  order  to  do  this,  it  is  neces¬ 
sary  to  examine  the  biphase  at  the  coincident  peaks  in  the 
east  and  north  components.  The  bicoherence  and  rotary  bico¬ 
herence  programs  can  furnish  this  information.  For  Figure 
3  the  biphase  value  for  all  peaks  is  essentially  0.  For 
all  peaks  of  Figure  4,  it  is  Tr/2,  and  for  all  peaks  of 
Figure  5  ,  it  is  -17/2.  This  means  that  for  the  coincident 
peaks  in  the  pair  consisting  of  Figures  3  and  4,  the  north 
biphase  leads  east  by  90°  and  for  the  pair  3  and  5,  north 
lags  east  by  90°.  The  fact  that  there  are  coincident  peaks 
implies  the  existence  of  coupled  sinusoids  of  the  same 

frequency.  The  biphase  difference  of  90°  implies  that  the 
sinusoids  can  represent  the  east  and  north  components  of  a 
rotating  vector,  and  the  sign  of  the  difference  gives  the 
sense  of  rotation.  Thus  the  conditions  above  can  exist  to¬ 
gether  only  if  Figures  3  and  4,  given  as  east  and  north, 
represent  a  coupled  counterclockwise-rotating  vector,  and 
if  Figures  3  and  5  represent  a  coupled  clockwise-rotating 


vector. 
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It  will  be  demonstrated  below  that  the  same  conclusions 
about  coupled  rotating  vectors  and  their  sense  of  rotation 
can  be  reached  by  examining  an  auto-rotary  bicoherence  plot 
of  these  pairs  of  signals. 

Figure  6  is  an  auto-bicoherence  plot  of  the  Hanned, 
overlapped,  artificial  signal 

s  =  g^  +  10  g-sin(16t)  -  50  cos (32t) 

where  g  is  Gaussian  noise  of  zero  mean  and  unity  variance. 
The  ridge  pattern  in  Figure  6  comes  from  the  joint  behavior 
of  the  second  and  third  terms  in  the  signal.  The  second 
term  is  a  product  in  the  time  domain  of  g  (white  noise, 
i.e.,  contains  all  frequency  components)  and  a  sinusoid 
(a  delta  function  at  16) ,  which  could  be  expressed  as  a 
convolution  in  the  frequency  domain.  The  convolution  re¬ 
produces  the  delta  function  at  all  the  frequencies,  not 
just  16.  The  sin(16t)  and  the  cos(32t)  are  phase-locked, 
because  no  randomness  is  introduced  into  the  phases,  hence 
the  g*sin(16t)  is  also  phase-locked  to  the  third  term. 

Noting  that  +  0)2  ~  =  0  is  a  requirement  for  a 

significant  bispectrum,  and  noting  that  the  second  term 
describes  a  signal  that  may  be  thought  of  as  a  modulation 
of  a  signal  at  16  to  the  new  frequencies  16  +  and 
16  -  and  letting  o)^  =  16  +a)^,  0)2  =  16  -  and 

^2  ~  that  +  0)2  -  =  0  for  all  co^!  Also, 
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tOi  +  0)2  -  0^3  =  0  if  (J^i  =  16.  Therefore,  we  obtain  signifi¬ 
cant  bicoherence  whenever  o)^^  +  W2  =  32  or  when  either 
=  32  or  0^2  ~ 

2.  Cross-bicoherence 

Figures  7  and  7a  are  cross-bicoherence  plots  of  the 
following  two  Banned  signals,  s^  and  s^: 

s  =  g  +  a (cos  8t  +  cos  16t  +  cos  24t) 

X 

s  =  g  +  a(sin{-8t)  +  sin(-16t)  +  sin(-24t))  . 

y  y 

Here  g  is  the  Gaussian  noise  of  Figure  1  and  g  is  the 

Gaussian  noise  of  Figure  2.  The  cross-bicoherence  between 

g  and  g  is  shown  in  Figure  7b.  The  form  is  g^g  a,  for 
^x  ^y  X  X  y 

‘^l‘^2“3  below).  The  amplitude  a  is  again  10.  Figure 

7a  displays  bicoherences  normalized  by  amplitude  as 
described  in  the  report  on  program  BISCAL.  Notice  first 
that  the  domain  has  increased  because  the  portion  of  the 
bi- frequency  plane  in  which  the  bicoherence  is  unique  has 
increased  for  cross-bicoherence.*  The  cross-bicoherence 
is  computed  here  by  using  s  as  the  source  of  w, ,  s 
again  as  the  source  for  0)2,  and  s^  for  0)3.  The  source 
signals  could  have  been  taken  in  the  only  other  unique  se¬ 
quence  s  s  s  .  It  can  be  seen  that  there  are  peaks  at  the 
X  y  y 

only  possible  coupled  frequency  triplets: 

*See  page  5  of  the  program  BISCAL  report  below. 
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(03^,0)2^033)  =  (8, 8, 16), (8, 16, 24)  ,  (-8,16,8)  , 

(-8,24,16),  and  (-16,24,8)  . 

Notice  that  in  effect  and  contain  both  positive 
and  negative  frequencies;  i.e.,  8,  16,  24,  -8,  -16,  -24. 
There  are  "edges"  of  peaks  at  the  frequency  triplets 
(-8,32,24),  (-16,32,16),  and  (-24,32,8).  These  are 

visible  because  of  the  frequency-spreading  due  to  Hanning, 
and  are  in  the  portion  of  the  bi-frequency  plane  which  is 
redundant  with  the  domain  plotted. 

Figure  7c  is  a  plot  of  average  bicoherence  where 
the  average  is  over  N,  the  number  of  points  used  in  calcu¬ 
lating  a  line  integral  over  the  diagonal  straight  line 
0)3  =  “03^  +  0)3  corresponding  to  the  locus  of 

all  frequency  triplets  having  a  given  "sum  frequency" 

(JO3  .  The  abscissa  is  the  sum  frequency  and  the  plot  is 
directly  based  on  Figure  7.  The  integrals  are  calculated 
by  program  BISUM.  It  is  seen  that  there  are  peaks  at  16 
and  24  for  positive  corresponding  to  the  two  frequency 

triplets  (8,8,16)  and  (8,16,24).  The  apparent  peak  at 
0)3  =  2  is  due  to  the  fact  that  only  one  point  contributes 

to  this  sum,  hence  the  "average"  is  poorly  specified.  For 
negative  0)3,  there  is  a  peak  at  8  corresponding  to  the  fre¬ 
quency  triplets  (-8,16,8)  and  (-16,24,8)  and  another  at 
16  corresponding  to  (-8,24,16).  The  peak  at  24  is  due 
solely  to  the  redundant  bicoherence  peak  at  the  frequency 
triplet  (-8,32,24)  as  mentioned  above. 


Figure  7d  is  a  plot  of  average  squared-bicoherence 
based  on  Figure  7,  which  emphasizes  the  peaks. 

3.  Auto-rotary  Bicoherence 

Figures  8  and  9  are  auto-rotary  bicoherence  plots  of 
Gaussian  noise  signals  used  as  background  noise  in  the 
plots  having  contours  at  the  confidence  levels  80,  85,  90, 

95,  99%  (all  except  Figure  17) ,  and  for  determining  these 
confidence  levels.  These  Gaussian  noise  signals  are  processed 
in  the  same  way  as  the  signals  in  which  they  serve  as  noise. 
Figure  8  differs  from  Figure  9  in  that  the  noise  of  Figure  8 
has  been  Hanned  and  overlapped,  while  that  of  Figure  9  has 
undergone  neither.  It  is  observed  that  both  plots  appear  to 
have  a  random  distribution  of  peaks. 

Figures  10,  11,  12,  and  13  are  auto-rotary  bicoherence 
plots  of  the  following  complex  signal:  s  =  (g^^+au)  +  i(g2+av) 

u  =  cos  8t  +  cos  16t  +  cos  24t  +  cos  (-8t)  +cos(-16t)  +cos(-24t) 
=  2 (cos  8t + cos  16t + cos  24t) 

V  =  sin  8t  +  sin  16t  +  sin  24t  +  sin(-8t)  +sin(-16t)  +sin(-24t) 
=  0 

g^,g2  =  Gaussian  noise,  mean  =  0,  variance  =  1 

a  =  10  for  Fig.  10,  1.0  for  Fig.  11,  0.1  for  Fig.  12, 

10  for  Fig.  13. 

This  complex  signal  has  three  counter-rotating  vectors  of 
frequencies  8,  16,  24.  In  Figures  10,  11,  and  12  the  signal 
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has  been  Banned  and  the  signal-to-noise  ratio  (S/N)  is  10, 
1.0  and  0.1  respectively.  There  are  marked  peaks  at  the 
same  frequencies  in  Figures  10  and  11,  but  Figure  12,  where 
S/N  is  down  to  0.1,  does  not  seem  to  differ  significantly 
from  Gaussian  noise.  It  is  apparent  from  the  relative  sizes 
of  the  contours  that  they  are  higher  on  the  peaks  of  Figure 
11  (S/N  =  1.0)  than  on  those  of  Figure  10  (S/N  =10)  as  ex¬ 
pected.  There  are  peaks  at  the  following  coupled  frequency 
triplets : 

(8,8,16),  (8,16,24)  quadrant  I 

(16, -8, 8),  (24,-8,16),  (24,-16,8)  quadrant  II 

(-16 , -8 , -24) ,  (-8, -8, -16)  quadrant  III 

(-16, 8, -8),  (-24,8,-16),  (-24,16,-8)  quadrant  IV 


In  a  rotary  bicoherence  plot,  a  peak  indicates  a  coupling 
of  two  rotating  vectors  of  frequencies  and  with  a 
third  of  frequency  The  sign  of  the  frequency  gives 

the  sense  of  rotation  in  all  cases,  positive  indicating 
counterclockwise.  Figures  10  and  11  demonstrate  that  there 
are  indeed  three  counter-rotating  vectors  of  frequencies 
8,  16,  24,  -8,  -16,  -24  which  are  pairwise  coupled  so  that 
the  sum  and  difference  frequencies  exist  in  the  same  set. 

Figure  13  is  an  auto-rotary  bicoherence  plot  of  the 
same  signal  with  a  S/N  =  10,  but  this  time  not  Banned.  Com¬ 
paring  it  with  the  Banned  case  of  Figure  10,  it  is  apparent 
that  the  peaks  are  still  present  at  the  same  frequencies, 
but  they  are  much  narrower  because  they  are  each  due  to  a 
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single  point.  The  peaks  (8,8,16)  and  (-8, -8, -16)  are  in¬ 
formed  because  the  one  contributing  point  lies  on  the 
boundary  of  the  contour  plot.  In  general,  these  peaks 
are  difficult  to  distinguish  from  the  Gaussian  noise  back¬ 
ground,  and  they  would  require  something  like  a  stereoscopic 
or  perspective  display.  Alternatively  one  can  raise  the 
contour  levels  to  emphasize  the  peaks  and  suppress  the  noise 
background.  This  is  done  in  Figure  17  in  which  the  contour 
levels  are  at  the  95,  96,  97,  98,  and  99%  confidence  levels, 
and  the  highlighting  is  apparent.  The  noise  background  it¬ 
self  is  separately  displayed  in  Figure  16. 

Figures  14  and  15  are  for  comparison  with  Figures  3,  4, 
and  5  in  connection  with  a  hypothetical  presentation  of 
Figures  3  and  4,  and  3  and  5  as  two  "east"  and  "north"  com¬ 
ponent  pairs  of  auto-bicoherence  plots.  Figure  14  is  an 
auto-rotary  bicoherence  plot  using  a  vector  series  whose 
u  and  V  components  are  identically  the  signals  of  Figures  3 
and  4  respectively.  Figure  14  displays  two  peaks,  at 
(8,8,16)  and  (16,8,24).  These  indicate  directly  that 
counterclockwise  pairs  of  rotating  vectors  of  rotation  fre¬ 
quencies  (8,8)  and  (16,8)  are  phase-locked  to  counterclock¬ 
wise  rotating  vectors  of  frequencies  16  and  24  respectively. 
Recall  that  Figures  3  and  4  had  to  be  used  in  conjunction 
with  biphase  information  to  arrive  at  the  same  conclusion. 
Figure  15  displays  two  peaks,  at  (-8, -8, -16)  and  (-16 , -8 , -24 ) , 
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indicating  a  similar  set  of  clockwise  rotating  vectors, 
for  which  conclusion  biphase  information  had  to  be  added 
to  the  auto-bicoherence  plots  of  Figures  3  and  5. 

Figure  18  is  a  cross— rotary  bicoherence  plot  between 
the  following  two  complex  signals,  called  X  and  Y: 

X  and  Y  are  of  form  s  =  (g^+au)  +  i (g^+av) ,  where: 

^l'^2  “  Gaussian  noise,  mean  =  0,  variance  =  1 
a  =  10 

For  X: 


u  =  cos(-8)  +  cos(-16)  +  cos(16) 
V  =  sin(-8)  +  sin(-16)  +  sin(16) 


For  Y : 

u  =  cos  8  +  cos  16  +  cos (-24) 

V  =  sin  8  +  sin  16  +  sin(-24)  . 

The  cross-rotary  bispectrum  and  bicoherence  are  computed 
with  X  supplying  X  supplying  ^ud  Y  supplying 

("Form  XXY") .  Figure  18  displays  only  two  peaks,  at  the 
coupled  frequency  triplets  (16, -8, 8)  and  (-16 , -8 , -24) . 

The  first  indicates  phase-locking  of  a  counterclockwise 
rotating  vector  of  frequency  16  with  a  clockwise  rotating 
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one  of  frequency  (-8)  to  produce  a  counterclockwise- 
rotating  vector  of  frequency  8.  The  second  indicates 
coupling  of  three  clockwise-rotating  vectors,  Examina¬ 
tion  of  the  input  frequencies  shows  that  these  are  in¬ 
deed  the  only  two  possibilities. 

D.  Empirical  Confidence  Levels  for  Bicoherence 

Figure  19  displays  empirically  determined  confidence 
levels  at  90,  95,  99,  and  99.9  percent  confidence  that  the 
bicoherence  lies  below  the  value  given  by  the  graph  as  a 
function  of  the  number  of  pieces  over  which  the  averaging  was 
done  and  the  equivalent  number  of  independent  pieces. 

The  data  were  supplied  by  program  BISCAL,  which  produced 
a  record  of  4096  auto— bicoherence  values  from  Gaussian 
noise  having  mean  o  and  unity  variance.  The  record  was 
processed  by  splitting  it  into  256-point  piece  lengths, 
Hanning,  and  50%  overlapping.  Program  BISCAL  placed  the 
bicoherences  into  bins  of  width  0.01,  determined  the  frac¬ 
tion  of  the  total  number  (4096  here)  lying  below  the  upper 
bin  limit,  and  calculated  the  above  confidence  levels  by 
linearly  interpolating  between  bins. 

The  dashed  line  in  Figure  19  is  the  modified  theo¬ 
retical  95%  confidence  level  determined  from  the  following 

5 

expression  (Haubrich,  1965) : 


1/2 


95%  confidence  level  =  (6/2P') 
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where : 

2P '  =  equivalent  degrees  of  freedom 
P'  =  equivalent  number  of  independent  pieces 
=  18P^/(19P-1) 

P  =  number  of  Banned,  50%  overlapped  pieces 

Examination  of  Figure  19  shows  that  5.9  would  be 
slightly  better  than  6.0  as  the  constant  in  Haubrich ' s 
expression. 

The  horizontal  axis  of  Figure  19  is  given  both  in 
P'  and  P.  If  one  had  neither  Banned  nor  overlapped,* 
then  the  P'  scale  should  be  used  to  determine  confidence 
limits;  if  the  pieces  were  Banned  and  overlapped,  the  P 
scale  is  applicable. 

The  curves  in  Figure  19  are  based  on  the  usual  ver¬ 
sion  of  bicoherence  (see  BISCAL  write-up)  which  normalizes 
the  modulus  of  the  averaged  bispectriom  by  the  autospectral 
energy  in  each  of  the  three  frequency  bands  being  examined. 
An  alternate  bicoherence  calculation  (see  also  BISCAL 
write-up)  nomalizes  each  bispectrum  before  the  average  is 


* 

One  should  only  overlap  if  windowing  is  also  being 
done,  otherwise  the  equivalent  number  of  degrees  of 
freedom  may  actually  be  reduced  (Nuttall,  personal 
communication,  1973) . 


calculated  and  the  modulus  taken;  this  is  done  to  em¬ 
phasize  phase  relations  and  minimize  amplitude  relations 
amongst  the  three  frequency  bands  being  examined.  The 
confidence  limits  (for  P  =  9  and  39)  are  shown  as  solid 
symbols  in  Figure  19;  for  95%  confidence  levels  on  "phase 
bicoherence"  the  usual  95%  confidence  level  is  satis¬ 
factory.  One  might  also  use  Haubrich's  simple  expression 
with  5.8  as  the  constant. 
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II.  Bispectral  Programs 

A.  Introduction  To  the  Bispectral  Program  Reports 
1 .  Summary 

Following  is  a  brief  summary  of  the  tasks  performed  by 
the  programs  described  in  Sections  B,  C,  and  D  below.  In 
reviewing  this  summary  it  will  be  helpful  to  refer  to  the 
flowchart  presented  immediately  following  the  summary  in 
Section  II. A. 2. 

Building  RWDISC  Data  File  Preparatory  to  Fourier 
Transform  (Section  B) 

a.  FRAGTAP;  QRDAT:  Two  main  programs,  run  con¬ 
secutively  from  TAPDIS  (RWDISC)  file  having 
multiple  pseudo-files  to  a  different  RWDISC 
file  having  21  logical  files,  the  21st  of 
which  is  a  facsimile  of  TAPDIS  pseudo-file 

1  (labels) 

b .  GENRAN ; *  Main  program  which  generates  RWDISC 
file  of  series  containing  any  combination  of: 

1)  Gaussian  noise 

2)  non-Gaussian  noise  of  form: 

ax  +  bx 

where  x  is  Gaussian  noise 

3)  signals  of  form: 

4 

'I  Aj^sin  (f  ^2^t+c()^^)  sin  (f 

4)  harmonics  of  form: 

6 

y  A .  sin  ( if  t+((> .  ) 

.  1  1 
1=1 

Modifying  RWDISC  File  from  I  by  Replacing  Data  Series 
with  Fourier  Coefficients  in  a  Special  Order  (Section  C) 

a.  FOURIER:  Main  program  which  does  Fourier  trans¬ 
form,  including  options  of  prewhitening,  tri¬ 
angular  weighting  of  consecutive  subsamples, 
splitting  into  contiguous  or  overlapping  pieces, 
subtraction  of  mean  or  trend,  and  Hanning. 
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Bispectral  Calculations  and  Plotting  (Section  D) 

a.  BISCAL:  Works  from  specially  organized 
RWDISC  file  produced  by  program  FOURIER, 
to  calculate  auto  and  cross-bispectra  of 
two  real  series,  to  write  a  disc  file  of 
bicoherences  for  transmittal  to  plotting 
program,  BPLOT,  and  to  compute  confidence 
levels  for  the  bicoherences. 

b .  BPLOT ;  Works  from  disc  file  produced  by 
programs  BISCAL  or  GENRAN  to  plot  auto 
and  cross-bicoherences. 

c.  BISUM;  Works  from  RWDISC  file  produced  by 
program  FOURIER  to  integrate  certain  bi¬ 
spectral  quantities  along  paths  of  constant 
sum  frequency  in  the  a)i,a)2  plane.  Produces 
disc  file  containing  integrals,  as  well  as 
another  disc  file  for  input  into  plotting 
program  BPLOT . 

d.  BIVEC:  Works  from  RWDISC  FILE  produced  by 
program  FOURIER,  to  calculate  auto  and  cross 
rotary  bispectra  of  two  vector  series,  to 
write  disc  files  of  rotary  bicoherences  for 
transmittal  to  plotting  program  RBPLOT ,  and 
to  compute  confidence  levels  for  the  rotary 
bicoherences . 

e.  RBPLOT:  Works  from  disc  files  produced  by 
programs  BIVEC  or  GENRAN  to  make  contour 
plots  of  auto  and  cross  rotary  bicoherences. 


2.  Flowchart  for  the  Bispectral  Programs 

Sections  IIB,  C,  D,  and  E  contain  reports  and  listings 
for  nine  programs  connected  with  bispectral  analysis.  The 
following  flowchart  is  presented  as  an  aid  to  understanding 
the  functions  of  the  various  programs,  and  should  be  con¬ 
sulted  in  reviewing  the  reports  on  them: 
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3.  Compatibility  with  Other  Systems 


The  programs  described  in  the  reports  and  listings  in 
Section  II  are  all  system-dependent,  the  system  being  the 
Xerox  CP-V  system  on  the  XEROX  SIGMA-7  computer  at  Woods  Hole 
Oceanographic  Institution  (WHOI) .  This  is  particularly  true 
of  those  programs  which  retrieve  and  organize  the  data: 
FRAGTAP,  ORDAT,  and  FOURIER.  If  one  were  to  attempt  to  adapt 
any  of  the  programs  described  below  to  another  system,  the 
most  tedious  but  straightforward  task  would  be  to  convert 
the  Xerox  Extended  Fortran-IV  statements  used  by  these  pro¬ 
grams  to  new  Fortran-IV  statements  wherever  necessary.  A 
helpful  discussion  of  differences  between  Xerox  Extended 
Fortran-IV  and  ANS  Standard  Fortran  is  given  in  the  reference 
manual  for  the  former."^  One  would  next  have  to  turn  atten¬ 
tion  to  the  subroutines  used  by  these  programs,  and  which 
reside  in  the  system  library  at  WHOI.  These  subroutines  are 
not  generally  listed  in  the  reports.  It  would  be  necessary 
to  either  rewrite  the  subroutines  to  be  compatible  with  the 
new  system,  or  replace  them  by  equivalent  subroutines.  The 
following  points  would  be  helpful: 

(a)  Mention  is  often  made  of  "RWDISC"  data  files 
throughout  these  reports.  RWDISC  is  a  machine-language  pro¬ 
gram  written  at  WHOI  to  provide  users  with  a  convenient 
method  of  using  the  disc  as  a  true  random-access  file(s) . 

It  uses  FORTRAN-callable  entry  points  for  reading,  writing, 
and  initializing,  and  it  sets  up  a  conceptually  simple  disc 
file  organization  upon  which  all  random-access  input  and 
output  in  the  following  programs  is  based.  One  would  prob¬ 
ably  not  attempt  to  adapt  RWDISC  to  another  system,  but 
rather  exploit  the  conceptual  simplicity  of  the  disc  file 
structure  and  FORTRAN  calls  by  providing  similar  alternatives. 
The  first  step  in  doing  this  would  be  to  consult  the  report 
on  subroutine  RWDISC. ^ 

(b)  FRAGTAP;  ORDAT:  Data  are  assumed  to  originate 
from  an  RWDISC-type  disc  file  of  a  particular  organization 
used  by  the  Moored  Array  Project  (the  "Buoy  Group")  at 
WHOI.  This  is  referred  to  in  the  report  as  a  TAPDIS^  disc 
file.  Programs  FRAGTAP  and  ORDAT  simply  reorganize  the  data 
into  another  different  type  of  RWDISC  file  to  be  used  in  all 
subsequent  processing.  These  programs  would  probably  be 
irrelevant  to  the  problem  of  running  the  bispectral  programs 
on  another  system. 

(c)  FOURIER:  Besides  RWDISC,  the  major  subroutine 
used  by  this  program  is  "HARMl",  which  does  the  Fast  Fourier 
Transform  (FFT)  on  the  data.  This  is  a  FORTRAN-IV  subroutine 


3 

which  resides  in  the  library  on  the  system  disc  at  WHOI . 
Again,  one  could  either  adapt  this  program  to  another  system, 
or  provide  an  alternate  subroutine  for  HARMl .  It  is  also 
possible  to  substitute  an  entire  program  for  FOURIER,  in 
order  to  supply  Fourier  coefficients  from  appropriately 
processed  data,  in  the  order  stated  in  the  report,  and 
in  the  RWDISC-type  disc  organization  required  by  the  bi- 
spectral  programs  BISCAL,  BISUM,  and  BIVEC .  There  are 
other  minor  subroutines  used  by  program  FOURIER,  and  these 
will  be  found  in  Reference  3. 

(d)  BISCAL,  BISUM,  BIVEC:  These  are  the  main 
bispectral  programs.  The  input  is  an  RWDISC  file  of  Fourier 
coefficients  as  described  in  the  respective  reports,  and 
output  is  one  or  more  consecutive  disc  files.  The  RWDISC 
file  has  been  discussed  above.  The  binary  WRITE  statements 
used  to  create  the  consecutive  files  should  not  have  to  be 
modified  in  another  system  using  FORTRAN  IV.  The  subroutines 
other  than  RWDISC  used  by  these  programs  are  minor  and  can 

be  found  in  Reference  3. 

(e)  BPLOT,  RBPLOT:  These  programs  make  contour 
plots  from  consecutive  files  produced  by  programs  BISCAL, 
BISUM,  and  BIVEC.  These  two  plotting  programs  use  a  set  of 
standard  CALCOMP-plotter  subroutines  which  should  be  avail¬ 
able  on  other  systems.^  These  include  the  following: 

PLOT  (with  entry  point  PLOTS) 

SYMBOL 

NUMBER 

Additionally,  programs  BPLOT  and  RBPLOT  use  subroutines  which 
reside  in  the  system  library  at  WHOI . ^  These  include: 

WHCNTR,  for  generating  contour  plots. 

Has  entry  points:  DIMWH,  GRID, 

NOLABL,  FLAGZ 


AXDRAW'I 

>  used  to  draw  axes  via  CALCOMP  sub- 
AXWJS  routine  calls 

-  plus  some  minor  programs  from  the  WHOI 
library. ^ 

The  binary  READ  statements  used  for  input  should  not  require 
any  change. 
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(f)  GENRAN :  This  utility  program  to  generate  arti¬ 
ficial  series  is  intended  to  be  run  on-line  in  the  context  of 
the  XEROX  CP-V  time-sharing  system.  It  can  possibly  be  adapted 
to  other  time-sharing  systems  if  the  required  subroutines  or 
substitutes  are  supplied.  Program  GENRAN  again  uses  sub¬ 
routine  RWDISC  to  create  a  disc  file  organized  in  the  RWDISC 
format.  The  only  other  subroutine  it  uses,  from  the  WHOI 
system  library,  is  subroutine  NORAN,  which  generates  pseudo¬ 
random  numbers  which  can  have  a  Gaussian  distribution  of 
specified  mean  and  variance. ^ 

4.  References  for  Section  IIA: 


1.  "Xerox  Extended  FORTRAN  IV"  Language  Reference  Manual, 
Xerox  Corporation  Publication  No.  90/09/56E. 

2.  "Handbook  for  Computer  Users,"  Woods  Hole  Oceanographic 
Institution,  pp.  V-E-1  ff. 

3.  "Reprints  of  WHOI  Programs,"  Information  Processing 
Center,  Woods  Hole  Oceanographic  Institution. 

4.  "Handbook  for  Computer  Users,"  Woods  Hole  Oceanographic 
Institution,  pp.  V-E-36  ff. 
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B.  BUILDING  RWDISC  DATA  FILE  PREPARATORY  TO  FOURIER  TRANSFORM 
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NAMES : 


FRAGTAP;  ORDAT 


PURPOSE :  To  transfer  data  series  from  one  or  more 

TAPDIS^  disc  files  to  another  RWDISC^ 
random  access  file  of  different  organi¬ 
zation,  for  use  in  bispectral  programs. 


MACHINE: 


Xerox  Sigma-7 


SOURCE  LANGUAGE:  FORTRAN  IV 


DESCRIPTION: 


Programs  FRAGTAP  and  ORDAT  are  two  main  programs  which 
are  intended  to  be  run  consecutively  in  the  same  job. 
Their  purpose  is  to  create  an  RI-TOISC^  random  access  file 
which  has  a  different  organization  from  the  input 
TAPDIS  file(s).^  The  major  reason  for  doing  this  is 
that  the  bispectral  programs  which  use  the  data  tend  to 
repeatedly  access  long  series  sequentially  from  the  disc. 
The  segment  length  into  which  the  logical  files  of  the 
new  RWDISC  file  are  divided  is  therefore  set  at  512  (the 
size  of  the  monitor  buffer  used  by  RIVDISC)  ,  rather  than 
73  in  the  TAPDIS  file.  Hence  there  is  one  disc  access 
per  512  words  rather  than  one  per  73  as  there  would 
otherwise  be.  Other  reasons  for  reorganizing  the  TAPDIS 
files  are  to  give  the  user  the  opportunity  to  select  from 
several  TAPDIS  files  only  those  series  of  interest,  and 
hence  produce  an  output  file  which  is  no  longer  than 
necessary,  and  to  simplify  the  structure  of  the  RWDISC 
files  to  be  input  into  the  bispectral  programs. 

The  reason  for  two  main  programs  is  to  allow  the  opening 
of  a  newly-structured  RWDISC  file.  Program  FRAGTAP 
creates  up  to  10  consecutive  files  from  the  TAPDIS  file 
which  it  reads.  There  is  one  consecutive  file  per  TAPDIS 
pseudo-file^  and  an  additional  consecutive  file  for  the 
TAPDIS  label  logical  file.  Any  logical  files  from  any 
TAPDIS  pseudo-file  may  be  selected  for  transmittal. 
Program  FRAGTAP  may  be  run  repeatedly  on  several  TAPDIS 
files  to  generate  more  consecutive  files.  Program  ORDAT 
reads  any  or  all  of  these  consecutive  files,  and  places 
the  contents  into  logical  files  of  the  user's  choice  in 
the  new  RWDISC  file. 


INPUT :  (FRAGTAP -ORDAT  sequence  considered  as  a  whole)  Input 

is  one  or  more  TAPDIS  files. 
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OUTPUT ; 

I.  Disc 


Upon  completion  of  the  FRAGTAP-ORDAT  sequence,  disc 
output  consists  of  a  single  RWDISC  file  having  21 
logical  files.  The  21st  logical  file  is  reserved 
as  a  facsimile  of  one  of  the  TAPDIS  label  files  read 
by  FRAGTAP.  There  is  one  data  series  per  logical 
file  in  logical  files  1  through  20  if  all  are  used. 

It  is  not  necessary  to  have  20  data  series  in  an  RWDISC 
file  having  21  logical  files.  Data  begins  at  location 
5,  the  first  three  words  being  the  Buoy-format  tape* 
data  file  name  from  which  this  series  originated,  and 
the  fourth  word  being  the  Buoy-format  variable  number. 

Upon  completion  of  the  FRAGTAP  program  alone,  there 
are  up  to  ten  consecutive  files.  One  of  these  (normally 
with  DCB  assignment  10)  is  a  facsimile  of  the  TAPDIS 
label  logical  file  (no.  1) .  The  others  each  contain 
all  series  in  sequence,  called  for  by  the  user,  from 
one  TAPDIS  pseudo-file,  associated  with  one  Buoy- 
format  tape  file.  The  data  start  in  location  10. 
Locations  1  through  9  contain: 

#1,2,3:  Buoy  tape  file  name  associated  with  this 

pseudo-f ile . 

#4:  Number  of  variables  read  from  the  TAPDIS 

pseudo-file . 

#5:  Number  of  cycles  for  this  TAPDIS  pseudo-file 

(from  TAPDIS  label) . 

#6, 7, 8, 9: Buoy  format  variable  numbers  for  up  to  four 
data  series. 

II.  Line  Printer 


Line  printer  output  from  a  typical  FRAGTAP-ORDAT  sequence 
is  shown  in  Appendix  1.  In  this  job,  20  data  files  were 
transferred  from  a  single  TAPDIS  file.  Input  and  out¬ 
put  originated  and  terminated  on  labeled  tape,  and  the 
programs  worked  from  the  scratch  pack. 

FRAGTAP  output 

(1)  fascimile  of  input  data  cards; 

(2)  starting  locations  of  each  successive  pseudo-file 
in  TAPDIS  file; 

(3)  summary  of  contents  of  each  consecutive  file 
produced . 


*This  is  a  name  used  for  a  standard  format  originated  and  used  by 
•the  Moored  Array  Project  at  Woods  Hole  Oceanographic  Institution. 
See  Reference  3. 
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ORDAT  output 

ORDAT  furnishes  a  complete  summary  of  the  contents  and 
disposition  of  each  input  consecutive  file.  This  in¬ 
cludes  the  original  Buoy  tape  file  name  associated 
with  the  TAPDIS  pseudo-file,  the  number  of  series  trans¬ 
mitted  from  that  pseudo-file,  the  data  series  length 
(excluding  label)  for  that  pseudo-file,  the  logical 
files  (destination)  of  each  series,  and  the  Buoy  variable 
numbers  associated  with  each  data  series  transmitted. 


USAGE : 


The  user  must  first  determine  whether  only  the  public 
(RAD)  disc  pack  will  be  used,  or  whether  he  will  ask 
for  a  private,  scratch  pack.  This  will  be  determined 
by  the  amount  of  data  to  be  handled .  When  the  scratch 
pack  is  used,  labeled  tape  will  probably  also  be  used 
because  of  the  size  of  the  files  involved.  Two  versions 
of  the  control  card  deck  will  be  presented.  The  first 
assumes  that  the  TAPDIS  file  exists  on  the  RAD,  that 
the  final  RWDISC  file  will  be  on  the  RAD;  and  that  only 
this  disc  pack  is  used  throughout.  The  second  assumes 
that  the  RWDISC  file  is  originally  on  labeled  tape, 
that  the  programs  will  work  from  the  scratch  pack,  and 
that  the  final  RWDISC  file  will  be  on  labeled  tape. 


CONTROL  CARDS: 

user  number 
account  number 

labeled  tape  with  input  TAPDIS  file 
labeled  tape  with  output  TAPDIS  file 
input  TAPDIS  file  on  RAD  or  labeled  tape 
output  file  (21  logical  files)  on 
RAD  or  labeled  tape 

Suppose  20  series  from  9  TAPDIS  pseudo-files  from  a 
single  TAPDIS  file  are  to  be  placed  in  logical  files 
1  through  20  in  order,  in  the  output  file. 

Version  1  (Everything  on  RAD) 

!JOB  aaa,uuu 

ILIMIT  (TIME, 1) , (CORE, 26) 

(ASSIGN  F:RAD, (FILE , TAPDISFILE) , (DIRECT) , (KEYED) 
(ASSIGN  F:l, (FILE,Tl) , (OUT) , (SAVE) 

(ASSIGN  F:2, (FILE,T2) , (OUT) , (SAVE) 

:  (consecutive  files  3  through  9) 

(for  label  file) (ASSIGN  F : 10 , (FILE ,T10) , (OUT) , (SAVE) 

(LOAD  (EF, (FRAGTAPR) ) , (UNSAT, (3) ) 

(RUN 

(DATA 


Let  uuu  = 

aaa  = 

INNN 
OUTT 

TAPDISFILE  = 
OUTFILE 
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- »  FRAGTAP  data  cards 

! ASSIGN  F:RAD,  (FILE . OUTFILE)  ,  (DIRECT)  ,  (KEYED)  ,  (OUTIN)  ,  (SAVE) 
lASSIGN  F;l, (FILE,Tl) 

:  (Consecutive  files  2  through  9) 
lASSIGN  F:10,  (FILE,T10) 

ILOAD  (EF, (ORDATR) ) , (UNSAT, (3) ) 

IRUN 

IDATA 

- ^  ORDAT  data  cards 

Version  2  (Initial  input,  final  output  on  labeled  tape; 
all  work  done  from  scratch  pack) 

IJOB  aaa,uuu 

ILIMIT  (TIME,1)  ,  (CORE, 26)  ,  (9T,1)  ,  (SP,1)  ,  (MOUNT,  (X,PACK) ) 

1 MESSAGE  USES  9T  INNN 
imessage  uses  9T  0UTT***WRITE 
ISPAK  (NRAN,1)  ,  (1500) 
lASSIGN  M:EO, (INOUT) 

IPCL 

COPY  LT#INNN/TAPDISFILE  TO  DP#PACK/Rl . : PAK (WR (ALL) , FA) 

REM  LT#INNN 
END 

lASSIGN  F:RAD, (SN,PACK) , (FILE,Rl, :PAK) , (INOUT) 
lASSIGN  F: 1, (SN,PACK) , (FILE, Cl , ;PAK) , (INOUT) 

:  (Consecutive  files  2  through  9) 
lASSIGN  F:10, (SN,PACK) , (FILE, CIO, :PAK) , (INOUT) 

ILOAD  (EF,  (FRAGTAPR)  )  ,  (UNSAT,  (3)  ) 

IRUN 

IDATA 

- ^  FRAGTAP  data  cards 

lASSIGN  M:EO, (OUT) 

ILOAD  (EF, (ORDATR ( (, (UNSAT, (3) ) 

IRUN 

IDATA 

- ^  ORDAT  data  cards 

IPCL 

SPE  LT#OUTT 

COPY  DP#PACK/R1. :PAK  TO  LT#OUTT/OUTFILE (WR (ALL) , FA) 

END 

Note  in  the  above  that  program  FRAGTAP  could  have  been 
run  more  than  once  to  access  several  TAPDIS  files,  and 
that  program  ORDAT  need  not  use  all  consecutive  files 
produced  by  FRAGTAP.  There  cannot  be  more  than  10  DCB 
assignments  at  any  time,  however. 


DATA  CARDS; 

All  data  card  entries  are  in  FORTRAN  IV  free-field 
generalized  format. 
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FRAGTAP 

Card(l):  NFILES-  number  of  pseudo-files  (one  per 

Buoy-format  tape  file)  to  access  from 
TAPDIS  file 

JDCB  -  NFILES  DCB  assignments  (one  consecu¬ 
tive  file  per  TAPDIS  pseudo-file) 

LDCB  -  one  DCB  assignment  for  TAPDIS  label 
logical  file 

Cards (2  through  NFILES+1) 

NSEQ  -  sequential  position  of  TAPDIS  pseudo-fil 
NV  -  number  of  variables  to  access  from  each 
TAPDIS  pseudo-file 

ILF  -  actual  RWDISC  logical  files  of  the  NV 
variables  in  TAPDIS  pseudo-file 

ORDAT 

Card(l):  NDCB  -  number  of  consecutive  files,  not 

Counting  label  file 
LDCB  -  DCB  for  label  file 

Cards  (2  through  NDCB+1) 

IDCB  -  DCB  of  a  consecutive  file  to  read 

(applies  to  this  entire  input  card) 
NSERIES  -  number  of  data  series  in  consecutive 
file  having  IDCB  DCB  assignment 
ILF  -  NSERIES  logical  files  in  output  RWDISC 
file,  in  which  to  place  data  series 
from  consecutive  file  associated 
with  IDCB 


RESTRICTIONS: 

(1)  No  more  than  ten  DCB  assignments  for  consecutive 
files  can  be  in  effect  at  any  time. 

(2)  No  logical  file  past  the  20th  can  be  used  for  data 
in  the  output  RWDISC  file.  The  21st  file  is 
reserved  for  labels. 

(3)  The  limiting  data  series  length  is  16000  words. 


STORAGE  REQUIREMENTS: 

Peak  core  cited  in  a  typical  run  of  FRAGTAP-ORDAT  was 
50  512-word  pages. 
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SUBPROGRAMS  REQUIRED :  None 


TIMING;  The  processing  of  20  12000-word  data  series  on  the 
scratch  pack,  starting  and  ending  with  RWDISC  files 
on  labeled  tape,  took  0.735  min  of  CPU  time. 


ERRORS  AND  DIAGNOSTICS; 

I .  FRAGTAP 

(1)  NERR  =  ...followed  by  "STOP  2" 

RDISC^  error  (type  NERR)  in  reading  word  100 
(number  of  pseudo-files)  in  TAPDIS  label  logical 
file. 

(2)  NERR  =  ...followed  by  "STOP  3" 

RDISC  error  (type  NERR)  in  reading  total  TAPDIS 
label  logical  file. 

(3)  NERR  =  ...followed  by  "STOP  4" 

RDISC  error  (type  NERR)  in  reading  a  TAPDIS 
data  file. 

(4)  ISTAT  =  ...followed  by  "STOP  3" 

BUFFER  OUT  error  (type  ISTAT)  in  writing  labels 
to  a  consecutive  data  file. 

(5)  ISTAT  =  ...followed  by  "STOP  1" 

BUFFER  OUT  error  (type  ISTAT)  in  writing  fascimile 
of  TAPDIS  label  file  to  consecutive  file. 

(6)  ISTAT  =  ...followed  by  "STOP  4" 

BUFFER  OUT  error  (type  ISTAT)  in  writing  a  con¬ 
secutive  file  of  data. 

II .  ORDAT 

(1)  ISTAT  =  ...followed  by  "STOP  1" 

BUFFER  IN  error  (type  ISTAT)  in  reading  label 
portion  of  a  consecutive  file. 

(2)  INWDS  =  ...followed  by  IDCB  =  ...followed  by  "STOP  10" 

BUFFER  IN  signalled  something  other  than  9 
words  for  number  read  in  label  portion  of  con¬ 
secutive  file  with  IDCB 

(3)  IDCB  =  ...;  NUMVAR  =  . . . ;  NSERIES  =  . . . ; 

"Stop  discrepancy  in  no.  of  variables" 

Number  of  series  specified  by  user  (NSERIES) 
disagrees  with  that  in  TAPDIS  label  file  for 
pseudo-file  corresponding  to  IDCB. 
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(4)  N  =  ...;  INWDS=. . • ; JCYC  =  - ;  "STOP  50" 

No.  of  words  of  data(INWDS)  read  by  BUFFER  IN 
disagrees  with  that  in  TAPDIS  label  file. 

(5)  ISTAT  =  . . . ;  "STOP  2" 

BUFFER  IN  error  (type  ISTAT)  in  reading 
consecutive  file  containing  TAPDIS  labels. 


PROGRAMMER:  GERARD  H.  MARTINEAU 


ORIGINATOR:  MELBOURNE  G.  BRISCOE 


DATE:  June,  1977 


REFERENCES : 

1.  Report  on  Program  TAPDIS  by  John  Maltais,  Woods  Hole 
Oceanographic  Institution. 

2.  "Handbook  for  Computer  Users,"  Information  Processing 
Center,  Woods  Hole  Oceanographic  Institution, 

pp.  V-E-1  ff. 

3.  "A  Nine  Channel  Digital  Magnetic  Tape  Format  for 
Storing  Oceanographic  Data,"  by  John  A.  Maltais. 

Woods  Hole  Oceanographic  Institution  Reference  No. 
69-55. 
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13,59  mar  95i»77  ID-0377 
j6p\A>a,i7i9 

LImIT  (TImE#4)  HCBREf  30)i  (9T,  1  )  i  (9p»  1  )#  (XipACk)  ) 

MESSAGE  USES  sT  I^JM 

message  uses  9T  IWJN)***wRITE 
SPAK  (NRA^il)/l500 

ASSIG*^'  m;E9,  (  INPu''') 

PCL 

CRRY  LT”*  I  ■*'UM/ I  WEX  T9  DP«P  a  C^/R  i  ••  Pak  ( i*iR  (  ALL)  #  E  A  ) 

rE^  lT*T'*'UM 

END 

PCL  PPeCcSSING  TeR'^INATeD 

assign  f;wad,  (sn^paco#  (EILe,Ri#  jRak)  .  <  in^ut) 

ASCtGn  E!1, (sN^PaCK), (FiLe,C1 . J PaK) # ( I NHUt ) 

assign  p:?*  ( sn/pac'< ) #  <»■  Il^^c^'  ‘pax ) '  ‘  ' 

ASSIG--  E  j  3  /  (SNiPACK  )  mFILE»C3.  tPAR  )  #  (  INMUT  ) 

ASSIGN  E;,^j  (SN^RACK),  (»•  ILE,C4.  :PAR)#  (  IN9LT  ) 

assign  e:s,  (sn^PaCK),  (^iLEiCS.  :Pa'<)>  ‘  inhUj) 

ASSIqN  plAii  (SN/pAc:<)*  (f-  ILE/C6'  SpAK)  »  (  INPUT) 

ASSIGN  E.7>  (SN/PACK)#  { E I LE > C7 .  • P AX  ^  (INPUT , 

ASSIGN  Ft  a*  (SN,PACK)*  (ElLE.Cg^ :PAX),  ( INPUT) 

ASSIGN  Ft  9,  (SNiPACO#  (FILE»CS*  !PAX)#  (  INPUT  ) 

ASSIGN  Ejio#  (SN^PACX),  (  F  I LE  ,  C 1.  0  #  J A  <  )  ,  (  INPUT  ) 

LPAO  (EP# (FRaGTAPR) ), (UNSaT, (3) ) 

jpi  associated# 


*  *  Ai_|_RCATIeNj  summary  *  * 

PRPTECTIPN  LPCATION  PAC:ES 


data  (on)  Aooo 

PRPCeDURe  (01)  F400 

D(;B  (10)  FFOO 

## 

RRPTECtION  TYPeSJ 


27 

o 


♦  SGN. 

C7L 

SIZE_0Pn.«K 

*  *  «  ** 

00 

Oj  PPRCf^rijB^ 

in  STATIC 

Sr  gh  I  *0 
SEgL^-O 

pDRl 

AOOO 

SpUMl-l 

SEgLP-1 

E735 

p400 

sr”Mi-P 

segUp-p 

E-5rr 

EEOO 

00  S  T  ZE  « 

4D92 

01  SIZE. 

336 

10  SIZE. 

000 

RUN 

INPUT  Records  fpllp'a  (in  geneRalueo  fpwmat) 

912345678  910  ^ 

1  2  2  3 

2^  3  2  3  4 

3  1  P 

4  3  2  3  4 

5  1  2 

6  2  2  3 

7  2  2  3 

8  3  ?  3  4  • 

9  3  P  3  4 


SEQUENTIAL 
INPUT  FILE  READ 
BY  TAPDTS 
1 


REL  LPCATIPN 
IN  TAPDIS 

file  (KPEL) 

1 


6o 


2 

12001 

3 

24001 

4 

36001 

5 

48001 

6 

60001 

7 

72001 

fi. 

84001 

9 

96001 

enTPUT 

FILE  sU^'^aRY  jm  Rpng;R 

«r 

ACCESS 

^UtPUt 

BU9Y 

T  A  PE  V  a  R  I  S 

DCB 

TAPe  ETLe 

accessed 

THIS  PILE 

1 

IWEX  Ai 

3  P 

9 

TwEX  A? 

1 

0 

9 

iwpx  b? 

3  3 

I  w  E  X  A  4 

1 

? 

3 

IwEX  A5 

1 

IwE)(  A6 

1 

9 

7 

IwEX  P6 

1 

p 

IwEX  As 

t 

p 

P 

q 

IwEX  Cio 

3  1 

p 

3 

♦stbp* 

output  Ce'^^^LFTED 

ASSiG'j  (euT) 

LRaD  (  fp’,  (  ^  ^  f  ^  ’ 

JPl  A5S?cI^‘'’tD» 


TPTAL  W9PDS 
T^  «lJT^^UT  ^ILf 


1?0C^ 

1?009 

1?009 

15009 

1  ?009 

IJ’OO^ 
IPOO'^ 
1  ?009 
1  pro'’ 


*  *  ALLf>CATI8Ni  SU'^maRY  ^ 


P'^'^TeCtIP^i  LPCATieN  PAGES 

DATA  <00)  Aqoo  ?7 

PrpCeDURe  P^OQ  ? 

DcB  (10)'  EEOO  9 


DATA  (OO)  Aqoo  ?7 

PrpCeDURe  P^OQ  ? 

DcB  (10)'  EEOO  9 


******************************  OGM. 

C7L 

s 

IZE,020»BK 

* 

***#*■»**  pc?btecYIrn  Types:  oo  d^"^^ 

01  Procedure 

10  STATIC 

SEGHI-o 

ECB3 

SEGHI-i 

P6A1 

SEGHI-9 

Fprr 

SEGLB-o 

^000 

SEGLO-i 

0 

0 

SFGLO-r 

EEqo 

00  SIZE* 

4CB4 

01  SIZE- 

2^? 

10  SIZE- 

Boo 

RUNi 


BUtPUt  SUMMaRV  FPR  DCB  1 

0yBv  fIlES  IwEX  A1  3 
NOt  0F  SERIES;  ? 

DATA  WDS •  EACh  SERIES*  1?000 
written  TS  L8G.  FILES;  i  2 
BU9Y  VaR.  NBS.:  ?  3 


sutput  summary  PeR  ocb  a 

BeiPy  fIlE!  IwPX  a? 

Me.  OF  SERIES;  3 
DATA  UDS.  EACH  SFRIESj  1?000 
WRITTEN  T0  LOG.  PILES;  345 


c 


60a 


c 

. .  BU9Y  VAR-  NOS.j 

1  2  3 

c 

enTPuT  Summary  fQr  dc«  3 

IWFX  Ba 

BU9Y.  FILE: 

N0,  BF  series: 

1 

c 

Data  ‘"Ds*  ea^h  series? 

12000 

written  t0  lbq.  files: 

6 

( 

BU0Y,.VAR*  M0St; 

3 

( 

BUTPUT  summary  F0R  DCB  A 

IWEX  Aa 

BueY  file: 

( 

N0*  eF  series? 

3 

data  wds.  each  series: 

12000 

written  T9  LBG.  FILES: 

7.  8 

( 

BU0Y  VaR.  nbs. : 

1 

1  2  3 

,(. 

eUTPi^iT  sunmary  For  dch  b 

IwEX  A5 

BUBy  F^^^? 

( 

N9.  0F  SERIES; 

1 

data  WDS,  each  SERIES. 

12000 

WRITTEN  TB  L0G-  FILES! 

10 

v. 

Buby  VaR-  nos* : 

1 

( 

eUTpUT  SUmmARy  fBR  6 

IWEX  A6 

BUBY  FILE; 

( 

NO.  BF  series; 

2 

pATA  wDS-  EAcH  SERIES! 

12000 

WRITTEN  TO  L9G-  FILES; 

11  12 

t. 

BUOY  VAR*  nbs.! 

1  2 

(; 

eUTPUT  SUHMaRY  for  DCB  7 

IWEX  B6 

. .  BUBY  file! 

■  . .  . .  .  N0.  OF  SE'^IES? 

2 

(, 

,  data  WDS.  EACH  SERIES; 

12000 

written  T9  LOG.  FILES- 

13  lA 

( 

BUOY  var*  NOS. : 

OUTPUT  summary  for  DCB  g 

1  3 

BUOY  file: 

iWrX  A 8 

NO*  0F  SpRlES; 

3 

1 

data  wDS.  EACH  series: 

12000 

written  to  log-  FILES; 

15  16 

( 

BUOY  var-  nos.! 

1  2  : 

C 

output  summary  For  dcb  9 

IwfX  CIO 

BUOY  file; 

l7 

3 


X 
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BUev  VAR-  nos.;  t  ?  ^ 


6(^TP(jT  SijMBArY  fSr  3 

«UOY  FILt;  iwrx  Bp 
MR.  RF  SfRIES!  1 
Data  ''Cs»  ea^^h  SE^^its?  l^o^'^o 

written  TR  f, 

HlJflY  VAR.  NOS..  3 


-3 


0UTPUT  plenary  Far  dCR  4 

BUR^'  rill: 

\R«  rF  RF^Its: 
data  WDS.  EACR  BFRItS; 
written  TR  LBB.  FILLS; 

BURY  VaR.  nos.: 


IwFX  A4 

1 

I?000 

7  8  9 

1  P  3 


QUT^LT  RU'^'^aRV  Fpr  DCB  5 

bury  fill; 

NR.  HF  SERILS; 
DATA  WDS.  EACH  5FRILS; 
written  TR  LRB.  FILLS! 

Bury  v^r.  nrs»  : 


Iw'^x  A=; 

1 

IPOOO 
1  0 
1 


RUTpUT  SUmmARy  f'^B  DCb  6 
BURY  FILL; 
NR.  RF  SFRItS; 

data  wDS.  EAcH  sepilS; 
4RITTEN  TR  LRG-  fills. 

BURY  var.  nrs.; 


TWFX  AA 

p 

IPDCO 
11  IP 
1  P 


RUtPUt  fUY^ARV  FbR  DCB  7 

BURT  file:  iwfX 

NR«  RF  SF’^ItS:  P 
data  wDS.  EACw  SFRILS;  IPnDO 
>vRITTEN  TR  LOG.  FILLS;  ip  14 
BURY  var.  nrs.:  1  3 


RUtPUT  SUNRaPT  FRR  DCB  8 
BURT  fill; 
NR.  rf  spoils: 
DATA  WCS.  facl  perils: 
written  TR  LPG*  EILLS; 

BURY  var.  nrs.; 


IWeX  A!? 

3 

1  PDDO 

15  16  17 

1  2  3 


RUtPUt  PUBBaRY  Err  OCB  g 

BURY  file:  TwfX  CIO 
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Mi?»  9F  sFRib-S!  3 
OATA  ioiDS*  EaCw  SE^ItS;  IPn^iO 

.^,RITTE^i  re  L9G.  fills:  i8  19  2c 

BljnY  V^R*  NHS»:  1  2  3 


900  w'^'^OS  J^,RITTFM  IN  LA^FL  L.  p.  NO.  21 
*9TBP*  NBR^AL  EN'D 
PCL 

S^E  LT«TLJN 

C  q  P  y  0  P  ^  P  A  C  ^  R 1  •  •  P  A  T  L  T  •  T  ^  '  ''J  I  '■*'  P  ^  ^  P  *  P  *  A  L  L  ^  ^  F  A  ) 

END 

PCL  PPeCESSING  TEP"^I'^'ArE:D 
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C.  MODIFYING  RWDISC  FILE  FROM  B  BY  REPLACING  DATA 
SERIES  WITH  FOURIER  COEFFICIENTS  IN 
A  SPECIAL  ORDER 
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NAME: 


FOURIER 


TYPE: 


Main  Program 


PURPOSE : 


To  create  RWDISC^^^  file  of  FOURIER  coef¬ 
ficients  from  RWDISC  file  of  data  series, 
for  input  into  bispectral  programs 


MACHINE: 


SIGMA-7 


SOURCE  LANGUAGE:  FORTRAN  IV 


DESCRIPTION: 


Program  FOURIER  takes  an  RWDISC  file  containing  a  number 
of  data  series  and  replaces  each  one  by  a  series  of 
Fourier  coefficients  which  is  specially  formatted  for 
efficient  access  by  the  bispectral  programs  written  by 
this  author.  The  series  may  be  processed  in  a  number  of 
ways  including:  a)  prewhitening  (done  on  the  original 
series  before  any  other  processing) ;  b)  compres¬ 
sion  of  the  series  by  triangular  weighting  on  consecu¬ 
tive  subsamples  (done  after  any  prewhitening  but  before 
any  further  operations);  c)  splitting  into  pieces, 
which  may  be  contiguous  or:  d)  overlapping  of  pieces 
by  50%;  e)  subtraction  of  mean  of  each  piece,  or  trend 
based  on  endpoints,  or  trend  based  on  linear  regression; 
f)  "Hanning"  of  pieces,  i.e.,  100  percent  cosine  tapering. 

Calculation  of  the  Fourier  coefficients  is  done  by  IPC 
program  HARMl . 


INPUT: 


Input  is  assumed  to  be  an  RWDISC  file  consisting  of  one 
data  series  per  logical  file,  starting  at  word  5  of  each 
logical  file,  the  first  four  words  being  reserved  for 
label  information.  Every  series  to  be  accessed  by 
program  FOURIER  is  assumed  to  be  of  equal  length.  There 
may  be  up  to  21  logical  files  in  the  input  RWDISC  file. 
If  there  are  1  through  20  inclusive,  every  logical  file 
may  contain  a  data  series.  The  case  of  21  logical  files 
is  considered  to  be  standard,  and  in  that  case  the  21st 
logical  file  is  reserved  for  label  information. 
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OUTPUT;  (1)  Disc 

Disc  output  is  a  modified  version  of  the  input  RWDISC 
file,  and  therefore  has  the  same  number  of  logical 
files.  Each  data  series  is  replaced  by  a  series  of 
Fourier  coefficients  starting  at  word  5  and  organized 
as  follows: 


Let  the  n-point  data  series  be  represented  by  the 
sequence ; 


{Y.},  j  =  0,  n-1 

and  the  Y.-th  term  by  the  expression: 

^  n/2 

Y.  =  a«  +  [a,  cos  (2Tr  jk/n)  +  b,  sin  (2tt  jk/n)  ] 


k=l 


Now  let  a,  ,  b,  represent  the  k-th  order  coefficients, 

for  the  m-th  piece.  Further,  let  represent  the 

sequence  of  k-th  order  cosine  coefficients  over  all 
pieces  taken  in  order,  the  overlapped  pieces  contribut¬ 
ing  the  even  sequence  m=  (2,4,6,...)  in  the  case  of 
overlapping.  Then  a  logical  file  of  Fourier  coefficients 
produced  by  program  FOURIER  has  the  appearance 


All  coefficients  b  are  zero  in  the  above  representa- 

Ti/  Z  in 

tion  of  the  data  series. 

It  will  be  noted  that  the  coefficients  necessary  to 
calculate  a  spectral  estimate  at  a  given  frequency  are 
always  contiguous. 

(2)  Line  Printer  (see  Appendix  2) 

Normally,  line  printer  output  consists  of  three  lines 
giving  the  processing  conditions  of  this  run,  and  the 
date  of  the  run.  Line  3  is  a  facsimile  of  an 
EBCDIC  label  written  on  logical  file  21  of  the  output 
RWDISC  file  (starting  at  word  1)  if  21  logical  files 
are  chosen.  The  entries  are  self-explanatory  if  it  is 
noted  that  when  referring  to  the  execution  of  a  given 
process,  0  means  "no"  and  1  means  "yes".  The  entry  "NO 
WDS  DATA"  refers  to  the  length  of  each  data  series  en¬ 
tering  the  program. 
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USAGE ; 

(1)  Control  cards 

Let  aaa  =  account  number 
uuu  =  user  number 
fff  =  input  name 

and  let  all  element  files  exist  in  account  462. 

Then  the  control  card  portion  of  the  input  card 
deck  appears  as  follows: 

!JOB  aaa, uuu 

ILIMIT  (TIME,4) , (CORE,50) 

lASSIGN  F:RAD, (FILE, fff) , (DIRECT) , (KEYED) , (INOUT) 

*  !L0AD(EF,  (F0URIERR,462)  ,  (CSUBR,462)  ,  (CTRLR,462)  ,0:NPUTR,  4  62 )  , 
! (K0EFHARMR,462) XOUTOMEGAR, 462 ) ) , (UNSAT, (3) ) 

!RUN 

IDATA 

*  If  all  element  files  are  contained  in  a  single 
file  FOURIERR,  then  these  two  cards  become 
simply:  'LOAD  (EF , (FOURIERR, 462) ), (UNSAT, (103) , (3) ) 

(2)  Data  cards 

There  is  a  single  data  card  followed  by  NAMELIST  input, 
which  must  be  terminated  by  an  *  card,  whether  or 
not  there  is  any  actual  namelist  input. 

The  data  card  has  8  or  9  entries,  all  in  FORTRAN  gen¬ 
eralized  format.  The  order  of  these  entries  is: 

IFIRST  -  the  first  logical  file  to  be  processed  by 
program  FOURIER 

ILAST  -  the  last  logical  file  to  be  processed  by 
program  FOURIER.  See  "RESTRICTIONS" 

ND02  -  the  data  length  in  words 

IPREW  -  prewhitening  switch  (0  or  1) 

ISUBSAMP  -  subsampling  switch  (0  or  1).  If  ISUBSAMP  =  1, 
triangular  weighting  of  the  subsample  will 
be  done  automatically. 

NSSMP  -  an  odd  number,  the  length  of  each  sub¬ 
sample;  to  be  entered  only  if  ISUBSAMP  =  1 

LPIECE  -  piece  length.  SEE  RESTRICTIONS  BELOW 

lOVERLAP  -  50%  overlap  switch  (0  or  1) .  This  will  be 
set  to  0  unless  Hanning  is  specified 
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ISUBT 


IHANN 


/  0  Don't  subtract  mean  or  trend  of  each 
piece 

1  Subtract  trend  based  on  endpoints  of 
j  each  piece 

j  2  Subtract  trend  based  on  linear 
regression 

^  3  Subtract  mean  of  each  piece 
Hanning  switch  (0  or  1) 


The  NAME  LIST  at  present  has  only  one  relevant  variable: 
MF  =  no.  of  logical  files  in  the  RWDISC  file.  The  de¬ 
fault  for  MF  is  21,  and  it  is  absolutely  essential  to 
enter  it  as  a  name  list  variable  if  MF  is  not  in  fact 
21.  Failure  to  do  so  will  not  produce  an  error  message, 
and  can  result  in  subtly  incorrect  answers. 


If  MF  is  four,  for  example,  follow  the  data  card  by 


MF  =  4  . 

If  MF  is  twenty-one,  follow  the  data  card  simply  by 


RESTRICTIONS: 

(1)  ND02  <  16000.  If  NPIECES  is  the  total  number  of  pieces, 
then  in  the  limit  as  NPIECES  ^  the  total  length  of 
the  output  series  of  Fourier  coefficients  will  approach 
2  X  ND02.  If  the  user  wishes  to  process  many  series  of 
length  considerably  shorter  than  16000,  it  may  be  ad¬ 
visable  to  recompile  the  program.  The  main  working 
array  WK  is  in  COMMON  and  is  normally  dimensioned 
WK(33000).  When  editing  the  source  program,  this  array 
dimension  should  be  set  at  (2xnd02) .  This  is  most  readily 
done  in  the  COMMON  of  every  program  and  subroutine  by 
combining  all  into  a  single  file. 

(2)  LPIECE.  There  are  several  important  restrictions  on 
the  length  of  a  piece;  all  of  which  must  be  met  before 
the  program  will  proceed: 

i)  LPIECE  must  be  an  even  number  with  no  prime  factor 
greater  than  5.^  Additionally,  it  is  assumed  that 
the  output  of  program  FOURIER  will  be  used  for  bi- 
spectral  calculations.  The  scalar  bispectral  pro¬ 
gram  BISCAL  requires  that  LPIECE  be  evenly  divisible 
by  4,  and  the  vector  (rotary)  bispectral  program 
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BIVEC  requires  that  LPIECE  be  evenly  divisible 
by  8.  Hence  these  added  restrictions  are 
placed  on  LPIECE.  Appendix  1  is  a  list  of 
piece  lengths  £  4000  which  can  be  used  for  pro¬ 
grams  BISCAL  and  BIVEC.  Numbers  in  parentheses 
are  not  divisible  by  8,  and  so  cannot  be  used 
in  connection  with  program  BIVEC.  Piece  lengths 
must  further  meet  the  following  criteria: 

ii)  LPIECE  must  satisfy  one  of  the  following  in¬ 
equalities;  Let  IND  be  the  data  series  length  after 
any  subsampling.  Then: 

450  ^  LPIECE  £  (IND/75)  for  50%  overlap 

-  or  - 

450  >  LPIECE  £  (IND/150  for  no  overlap 

These  limits  can  be  changed  by  minor  source  program 
modifications.  Brief ly, to  increase  the  upper  limit, 
change  the  dimension  of  all  arrays  of  size  450  to  the 
new  upper  limit.  To  decrease  the  lower  limit,  all 
arrays  of  size  150  must  be  changed  to  size  J ,  where 
the  denominator  of  the  lower  limit  above  is  (J/2) 
for  50%  overlap  and  J  for  no  overlap. 


i) 

MF 

1  21 

ii) 

If 

MF  = 

1 — 1 

CN 

then 

ILAST 

<  21 

iii) 

If 

MF  < 

21, 

then 

ILAST 

<  MF 

ERRORS  AND  DIAGNOSTICS; 

(1)  "PIECE  LENGTH  OF ...  INVALID .  MUST  BE  FROM  THE 

FOLLOWING  SET:" 

Meaning:  The  user  has  specified  a  piece  length 

which  fails  to  meet  criterion  i) ,  item 
(2)  of  "RESTRICTIONS"  section  for  pro¬ 
gram  BISCAL.  The  piece  lengths  which 
are  output  are  those  of  Appendix  1. 

Action:  Abort 

(2)  "PIECE  LENGTH  DOES  NOT  SATISFY  RESTRICTION  FOR 

(NO)  OVERLAP" 

Meaning:  The  user  has  specified  a  piece  length 

which  does  not  satisfy  one  of  the 
criteria  ii) ,  item  (2)  of  "RESTRICTIONS" 


Action : 


Abort 
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(3)  "SUBSAMPLE  LENGTH  MUST  BE  ODD" 

Meaning:  The  user  has  specified  subsampling  with 

an  even  subsample  length. 

Action:  Abort 

(4)  "OVERLAP  POSSIBLE  ONLY  IF  HANN.  lOVERLAP  SET  TO  0" 

Meaning:  Self-explanatory 

Action:  Proceed  with  no  overlapping. 

(5)  "MF  CANNOT  EXCEED  21" 

Meaning:  User  must  not  specify  more  than  21 

logical  files 

Action:  Abort 

(6)  "LAST  LOG  FILE  CANNOT  EXCEED  MF  OR  20" 

Meaning:  One  of  the  following  conditions  was  not  met: 

(a)  If  MF  =  21,  the  last  logical  file 
to  be  processed  must  be  less  than 
21; 

(b)  If  MF  <  21,  the  last  logical  file 
must  not  exceed  MF . 

Action:  Abort 

PROGRAMMER:  GERARD  H.  MARTINEAU 

ORIGINATOR:  MELBOURNE  G.  BRISCOE 

DATE:  June,  1977 

REFERENCES:  (1)  "Handbook  for  Computer  Users,"  Woods 

Hole  Oceanographic  Institution,  pp  V-E-lff. 

(2)  "Reprints  of  WHOI  Programs,"  Woods  Hole 

Oceanographic  Institution,  HARMI  Report. 


APPENDIX  1 
(FOURIER) 
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APPENDIX  1 


Numbers  divisible  by  four  and  £  4000  containing  no 
prime  factor  greater  than  5 : 

(Numbers  in  parentheses  may  not  be  used  for 
piece  lengths  to  be  handled  by  program  BIVEC) 


(12) 

(108) 

16 

120 

(20) 

128 

24 

144 

32 

160 

(36) 

(180) 

40 

(192) 

48 

200 

(60) 

216 

64 

240 

72 

256 

80 

288 

96 

(300) 

(100) 

320 

(324) 

768 

360 

800 

384 

864 

400 

(900) 

432 

960 

480 

(972) 

(500) 

(1000) 

512 

1024 

(540) 

1080 

576 

1152 

600 

1200 

640 

1280 

648 

1296 

720 

1440 

(1500) 

2560 

1536 

2592 

1600 

(2700) 

(1620) 

2880 

1728 

2916 

1800 

3000 

1920 

3072 

1944 

3200 

2000 

3240 

2048 

3456 

2160 

3600 

2304 

3848 

2400 

3888 

(2500) 

4000 

APPENDIX  2 
(FOURIER) 
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NAME: 


BISCAL 


TYPE: 


Main  Program 


PURPOSE : 


To  calculate  auto  and  cross-bispectra  of 
two  real  series,  to  write  a  consecutive 
file  of  bicoherences  for  transmittal  to 
plotting  program  BPLOT, ^  and  to  compute 
confidence  levels  for  the  bicoherences. 


MACHINE: 


Xerox  Sigma-7 


SOURCE  LANGUAGE:  FORTRAN  IV 


DESCRIPTION : 

Program  BISCAL  uses  as  input  an  RWDISC^  file  of 
FOURIER  coefficients  having  a  particular  order  to 
be  described  below.  These  coefficients  are  assumed 
to  result  from  real  data  series  and  are  normally  the 
output  of  program  FOURIER,^  which  has  done  any  nec¬ 
essary  prewhitening,  subsampling,  overlapping,  mean 
and  trend  removal,  and  Hanning.  If  L  is  the  piece 
length  and  NP  is  the  number  of  pieces  resulting 
from  program  FOURIER,  there  are  (L) (NP)  words  in¬ 
put  into  BISCAL  for  each  data  series. 

Program  BISCAL  then  computes  approximately  (3/4)  _(L/2)^ 
values  of  bicoherence,  along  with  the  corresponding 
biphase  and  biphase  error  if  desired.  Two  alternate 
forms  of  bicoherence  may  be  calculated.  The  default 
form  is  that  defined  by  N.  C.  G.  Yao.**  The  other 
form  is  a  normalization  by  amplitude,  so  that  only 
phase  information  remains  (see  below) .  The  user  can 
elect  to  have  the  program  write  a  consecutive  file 
of  bicoherences  to  be  used  as  input  to  program  BPLOT 
for  plotting.  The  user  can  also  instruct  the  pro¬ 
gram  to  determine  those  bicoherences  which  corres¬ 
pond  to  specified  confidence  levels.  A  listing  of 
partitioning  of  bicoherences  into  bins  of  specified 
size  can  be  obtained,  as  well  as  a  listing  of  bi- 
coherences  and  related  quantities  when  the  bicoher¬ 
ences  fall  between  limits  set  by  the  user. 
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Computations  Performed 
A.  Bispectra 


Form  1 


The  default  definitions  of  bispectrum, bicoherence 
and  biphase  used  by  program  BISCAL  are  those  given 
by  N.  C.  G.  Yao‘*except  for  the  definition  of  the 
"sum  frequency"  033.  Consider  two  real  time  series 
from  which  are  derived  three  complex  Fourier  coef¬ 
ficients,  each  of  which  may  come  from  either  series. 
Let  these  coefficients  be  X(a)i),  X(a)2)/  and  X(w3). 
Since  we  are  considering  real  time  series,  the  real 
part  of  X(a)]<;)  is  an  even  function  and  the  imaginary 
part  is  an  odd  function  about  the  frequency  origin. 
Using  this  property. 


X(a),  ) 
k 


ib. 


when 


when 


to,  >  0 
k 


to,  <  0 
k 


(1) 


The  average  bispectrum  over  the  pieces  under  consid¬ 
eration  is  then  defined  as  <B(t0j^,(02)  >,  where: 


=  <X  ((Oj^)X  ((02)X*  (0)3)  >  (2) 

when  tOj^  +  t02  =  to^ 

=  0  when  10^  +  t02  7^ 

In  the  frequency  domain  of  interest  (see  below) , 

00^  >  0  always,  and  [to^^l  >  1 102 1  •  Since  to^  =  to^  +  t02, 

we  have  that  co^  >  0  in  this  domain  always,  and 
therefore 

X*  =  a^  -  ib^ 


The  second  Fourier  coefficient  X(t02)  ranges  over 
both  positive  and  negative  frequencies  in  the  domain 
of  interest  and  is  evaluated  according  to  equation  (1) . 
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Expanding  equation  (2)  above,  we  have  that: 


Re<B  (a)^,aj2)  >  =  <a^a2a2  ±  a^b2b2  +  t'j^a2b2  +  b^b2a2>  (2a) 

Im<B  {(ij^,(D2)  >  =  <±aj^b2a2  -  a^a2b2  +  t'j^a2a2  ±  b^b2b2>  (2b) 

where  the  upper  signs  correspond  to  0J2  ^  0  and  the 
lower  to  0)2  <  0  • 

The  bicoherence  bic  (^^^,0)2)  is  then  defined  as: 

I  <B  (w^,a)2)  >  1 

bic(u),  ,a)~)  =  - — 9 - ;  ~2  T/J 

^  ^  I<|X(u),)  r><lX(a)2)  r><lx(co^+a32^  '  ^ 

(3) 

and  the  biphase  [biphase  (03^,002)]  as: 


Im<B  (03^^,032)  ^ 

biphase  (03^,032  )  =  tan  Re<B  (w^’, 


Form  2 

Program  BISCAL  can  compute  an  alternate  form  of  bi¬ 
coherence  based  on  an  amplitude-normalized  bispec¬ 
trum  .  Let : 

Bj^  =  Real[X(to^)X(u32)X*  (a3^+(332  )  ] 

Bj  =  Imag  [X  (03^)  X  (032)  X*  (03^+032)  ] 
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The  average  bispectrum  over  the  pieces  under  con¬ 
sideration  is  then  defined  as  <B '  (oj^^  ,  0)2)  >  /  where: 

-  <-f  +  l-g->  -  <-5->  +  i<^>  . 

The  amplitude-normalized  bicoherence  is  then  de¬ 
fined  as: 


bic  '  (tiJ^,(j02)  =  1  <B '  / 0)2 )  > 


The  biphase  is  now: 


biphase  (to^ , 0)2) 


tan 


Im<B'  (03^,002)  > 
Re<B'  (03^,002)  > 


Frequency  Domains 

Because  of  symmetries  in  the  bispectrum,  it  is  not 
necessary  to  let  the  constituent  frequencies  range 
over  all  possible  values.  If  all  three  coefficients 
in  (1)  above  are  based  on  the  same  series,  then  the 
"auto-bispectrum"  and  "auto-bicoherence"  are  being 
calculated  and  the  minimum  necessary  domain  is: 


{a}  =  {{^2  £  D  {o32  £  +  'L/2}  r\  ^^2  ^ 

(5) 

where  {032  £  actually  means  {(03^,032)  ^  039  £ 

etc.,  and  where  03^  +  (02  ~  =  0  and  L  is  the  piece 

length,  or  pictorially: 


Figure  1 
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Whenever  more  than  one  data  series  enter  the  compu¬ 
tation  of  the  three  coefficients  in  (1) ,  then  the 
minimum  necessary  domain  becomes; 

{C}  =  {{a}  U  Hc02  ^  ^  ^‘^l  1  L/2}/^  {t02  <  0}}} 

(6) 

where  +  002  -  (^^3  =  0,  L  is  the  piece  length,  and 
{a}  is  defined  in  (5) ,  or  pictorially: 


In  this  case,  we  say  that  "cross-bispectrum"  and 
"cross-bicoherence"  are  being  computed. 

Order  of  the  Computations 

Program  BISCAL  can  handle  two  data  series,  each  of 
length  16K  words.  This  means  that  for  50%  overlap 
and  for  the  limiting  case  of  an  infinite  number  of 
pieces,  each  data  series  entering  the  program 
consists  of  32K  FOURIER  coefficients.  In  order  to 
permit  computation  of  the  bispectra,  and  to  minimize 
the  number  of  disc  accesses,  the  following  steps  are 
taken : 

1)  Organization  of  input  file 

th 

Let  {a^}  be  the  set  of  all  real  parts  of  the  i 

frequency  FOURIER  coefficient  taken  over  all 
pieces,  and  let  {b^}  be  the  corresponding  imaginary 

parts.  Then,  for  a  piece  length  of  L,  the  input 
file  elements  have  the  following  order: 
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{aQ},  {a^},  {b^},  {^2},  {b2},...{aj^  },  {b^^ 

2  "  ^  2 


},  {a 

1 


The  elements  of  b^  are  all  zero  and  do  not  appear 

Xj 

'2  ^ 

in  the  input  file.  Program  FOURIER  automatically 
outputs  coefficients  in  this  order.  This  permits 
all  elements  associated  with  a  given  frequency  to 
be  input  by  entering  the  series  only  once. 


2)  Organization  of  frequency  domain  and  computation 
procedure 


No  more  than  (L/2  +  2) (NP)  elements  from  each  series 
are  in  core  at  any  time,  where  L  =  piece  length,  and 
NP  =  no.  of  pieces.  These  elements  correspond  es¬ 
sentially  to  the  "top"  and  "bottom"  halves  of  each 
series.  This  causes  the  domain  of  Fig.  2  to  divide 
naturally  into  five  sub-domains  or  "rasters"  as  in¬ 
dicated  by  the  dashed  lines  in  the  following  figure: 


Figure  3 


Computations  of  bicoherences  proceed  for  each  raster 
in  order.  The  reading  of  series  "halves"  from  the 
disc  is  a  function  of  each  particular  combination 
of  source  series  for  the  three  frequencies,  an  at¬ 
tempt  being  made  to  maximize  efficiency.  Within 
each  raster,  computation  of  bicoherences  is  done 
from  left  to  right  along  diagonal  scans  of  slope 
(-1) ,  each  scan  thus  corresponding  to  a  single  sum 
frequency  103  .  The  disc  is  accessed  for  the  coeffi¬ 
cients  of  frequency  0)3  only  when  these  coefficients 
are  not  already  available  in  core. 
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Averaging  over  user-specified  pieces  is  done 
g0pa.ratelY  on  the  real  and  imaginary  parts  o 
the  bispectrura,  equations  (2a)  and  (2b) ,  and 
on  each  autospectrum  in  the  demonimator  of 
equation  (3).  The  averages  are  then  used  in 
calculating  bicoherence  and  biphase. 

B.  Confidence  levels 

As  each  bicoherence  is  computed,  the  user  may  elect 
to  assign  it  to  a  bin  having  a  size  of  his  choice. 

User  may  also  determine  the  number  of  bins  by 
specifying  the  upper  bicoherence  limit  to  be  con¬ 
sidered.  After  this  sorting  has  been  done,  program 
BISCAL  determines  the  bicoherences  below  which 
specified  fractions  ("confidence  levels")  of  the 
total  number  of  bicoherences  calculated  bv  the 
program  lie.  This  is  done  by  calculating  the  frac¬ 
tion  of  the  total  which  lies  below  the  upper  limit 
of  each  bin,  finding  the  two  closest  such  fractions 
which  "bracket"  the  specified  confidence  level,  and 
linearly  interpolating  the  two  corresponding  bico¬ 
herences  to  find  the  one  which  corresponds  to  the 
specified  confidence  level.  A  dump  of  the  distribu¬ 
tion  is  available. 

USAGE ; 

(1)  Tailoring  load  module  size 

For  long  series  of  FOURIER  coefficients,  it  is  de¬ 
sirable  to  have  large  data  buffers  to  keep  disc 
accesses  to  a  minimum.  On  the  other  hand  these 
large  data  buffers  can  be  wasteful  for  shorter  series 
both  in  terms  of  (page  •  minutes)  charges  and  the 
penalty  in  turnaround  time.  The  user  is  therefore 
advised  to  recompile  the  program  to  match  his  needs 
if  he  is  going  to  be  handling  a  number  of  data  series 
of  comparable  length.  To  edit  the  program  prior  to 
recompilation,  the  following  steps  should  be  observed: 

a.  Copy  the  source  file  to  a  duplicate  file,  and 
then  work  with  the  duplicate  file; 

b.  Change  the  DIMENSION'S  of  OMl  and  OM2  arrays  to 
at  least  [ (L/2  +  2)  (NP) ] ,  where  L  =  piece  length 
and  NP  is  the  number  of  pieces. 

c.  Check  that  array  W3  is  DIMENSIONed  at  least  2(NP) . 

d.  Check  that  SQ  is  DIMENSIONed  at  least  SQ (L/4 + l,L/4 + 1) 
(both  dimensions  identical) . 

e.  Check  that  the  initialization  of  variable  ISQD  is 
identical  to  both  dimensions  of  SQ. 

f.  Recompile. 
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(2)  Control  cards 


Let  aaa  =  account  number 
uuu  =  user  number 

fff  =  input  file  name  (RWDISC,  keyed) 

ttt  =  file  name  for  transmittal  to  plotting 
program  (consecutive) 

Assume  the  element  file  is  called  BISCALO  and  exists 
in  account  aaa.  The  Control  Card  portion  of  the  in¬ 
put  deck  is  then  as  follows: 

!JOB  aaa, uuu 

*  ILIMIT  (TIME, 4) , (CORE, 48) 

lASSIGN  F:RAD,  (FILE, fff),  (DIRECT) , (KEYED) 
t  lASSIGN  F:l,  (FILE, ttt)  ,  (OUT)  ,  (SAVE) 

ILOAD  (EF, (BISCALO) ) ,  (UNSAT, (3)) 

!RUN 

IDATA 

(DATA  CARDS) 

( 3 )  Data  cards 


Program  BISCAL  has  NAMELIST  input  followed  by  one  or 
two  data  cards  depending  on  the  application.  The 
NAMELIST  input  must  be  terminated  by  an  *  card  whether 
or  not  any  NAMELIST  variables  are  being  input. 

The  NAMELIST  parameters  and  their  default  values  are 
as  follows.  In  general  the  switches  are  to  be  set 
to  0  for  "off"  and  1  for  "on". 


Time  and  core  limits  will  vary  widely  depending  on 
application.  See  below. 

4* 

Necessary  only  if  storing  matrix  of  bicoherences  on 
disc,  for  transmittal  to  plotting  program  BPLOT. 

DCB  assignment  may  be  changed  by  NAMELIST  parameter 
ISTORE. 
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NAMELIST  VARIABLE 

MEANING  DEFAULT  VALUE 

MF 

Number  of  logical  files  in 
input  RAD  file 

21 

IDATSTART 

Starting  location  of  data  in 
each  input  logical  file 

5 

INORM 

Switch  to  calculate  amplitude- 
normalized  bicoherences 

0 

LISTBI 

Switch  to  list  bicoherences 
and  associated  quantities 

0 

I  DUMP 

Switch  to  store  bicoherences 
in  a  consecutive  file  for 
transmittal  to  plotting 
program  BPLOT 

1 

I STORE 

DCB  assignment  for  consecu¬ 
tive  file  of  bicoherences 
created  by  setting  switch 

IDUMP 

1 

KONF 

Switch  for  determining  bi¬ 
coherence  confidence  levels 

0 

BINSIZE 

Bin  width  for  sorting  bico¬ 
herences.  A  given  bicoherence 
is  placed  in  bin  1/  where 

I  =  INT  (bicoherence/BINSIZE)  +  1 

0.01 

BICOHLIM 

The  bicoherence  "limit"  for 
sorting  which  determines  the 
number  of  bins  of  size  BINSIZE, 
by  determining  the  integer  NBINS 
obtained  by  rounding  (BICOHLIM/ 
BINSIZE) ,  and  then  redefining 
BICOHLIM  as  (NBINS) (BINSIZE) 

1.5 

KBl 

Switch  to  display  partitioning 
of  bicoherences 

1 

KB2 

Switch  to  display  fraction  of 
total  bicoherences  under  each 
bin  limit 

1 

IHANN 

Determines  method  of  calculating 
phase  error  when  LISTBIf^O  (See 
PHSERR,  Page  12) 

IHANN=0  not  Banned  and  not 
overlapped 

IHANN=1  Banned  and  overlapped 

1 
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NAMELIST  VARIABLE  MEANING  DEFAULT  VALUE 

SIGLVL  95%  confidence  level  for  * 

bicoherences,  above  which 
phase  error  PHSERR  is  calcu¬ 
lated  and  printed  when 
LISTBI=1 


The  data  cards  follow  the  *  card  which  terminates  NAMELIST 
input.  They  are  all  generalized,  free-field  format  and 
are  as  follows; 


Card  1  (Mandatory) 


Variable  No. 

1 

2 

3 

4 


Meaning 


Logical  file 
Logical  file 
Logical  file 
Total  number 


for  first  series^ 

f 

for  second  series 

for  sum  frequency^ 

of  pieces  in  each  series 


5 

6 

7 

8 
9 


} 

1 


Piece  length 

Lower,  upper  piece  sequence  numbers  inclusive, 
between  which  user  wants  to  average 

Lower,  upper  limits  determining  when  to  print 
bicoherences  when  LISTBI^^O.  Bicoherences 
must  satisfy:  (var.  #8)  <  bicoherence  _<  (var.  #9  ) 


Card  2  (Input  only  when  KONF^^O) 


Variable  No. 


Meaning 


1  (NCONF)  Number  of  confidence  levels  to  follow  (^10) 

2  (CONF(I))  NCONF  confidence  levels  expressed  as  a 

decimal,  0  to  1 


Default  is  an  approximate  value.  If  P  =  number  of 
pieces,  let  the  number  of  degrees  of  freedom  EDOF 
be  defined  as  follows: 

r 36P^/ (19P-1)  for  Hanning,  overlapping 
EDOF  =  j 

(^2P  for  no  Hanning,  no  overlapping 

Then  the  default  value  of  SIGLVL  is 
SIGLVL  =  (6 /EDOF) 


If  the  first  three  variables  are  equal,  the  program 
automatically  reverts  to  calculation  of  auto¬ 
bicoherences  based  on  a  single  file,  choosing  the 
minimum  necessary  domain. 
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OUTPUT ; 

(1)  Line  Printer 


Typical  line  printer  output  is  displayed  in  Appen¬ 
dix  1.  First  a  dump  of  NAMELIST  parameter  values 
is  printed,  followed  by  a  facsimile  of  input  data 
cards.  Next,  if  confidence  levels  are  called  for, 
the  "adjusted  bicoherence  limit"  (as  determined  by 
the  rule  given  in  describing  variable  BICOHLIM  in 
the  section  on  Data  Cards  above)  is  printed. 

This  is  followed  by  a  listing  of  individual  bico¬ 
herences  if  called  for.  There  is  one  bicoherence 
value  per  line,  plus  other  output  described  be¬ 
low.  The  listing  occurs  only  within  the  limits 
given  by  variables  #8  and  #9  on  Card  1.  The  user 
is  cautioned  that  for  cross-bicoherences  the  total 
number  of  bicoherences  computed  is  about  0.75 
(LP)2  where  LP  =  piece  length.  Without  sufficiently 
narrow  limits  on  the  bicoherences  actually  printed, 
this  can  result  in  a  very  large  number  of  output 
pages.  The  items  output  in  each  line  depend  on 
which  form  of  bicoherence  is  called  for  in  the 
program.  They  are  as  follows,  in  order  of  appear¬ 
ance  from  left  to  right  on  the  line: 

(A)  Default  bicoherence  (after  Yao) : 

Heading  (s)  Meaning 


FI  F2  F3 

BIC 

BIPH 

BIMOD 

BISPECR 

BISPECI 

AUTOFl 

AUTOF  2 

AUTOF1F2 


frequency  triplet  (sequence  numbers) 
associated  with  this  bicoherence 

bicoherence 

biphase 

I  <B  ((0^,CJ2)  >  1 

Re  <B  (Wj^ ,  (1)2)  > 

Im  <B(a)^,a)2)> 

<  |x(ajj_)  I 

<Ix((i02)  I 

<  Ix  (0)3)  I 


85 


BISCAL 
July  1977 
Page  12 


Heading (s) 
SD 

PHSERR* 


Meaning 

[<  |x(w^)  l^x  |X(W2)  I^x  Ix(a33) 

phase  error;  depends  on  IHANN  (see  page  9) 


=  /T9  for  IHANN=0 ,  P  =  no.  of  pieces 
=  57.296  sin"^  [ 1 . 96/ (BIC ‘W) ]  for  IHANN=1 
(default),  where  W=  [36P^/ (19P-1)  ] 


(B)  Alternate  bicoherence  (normalized  by  amplitude) 


Heading  (s) 


Meaning 


FI  F2  F3 

BIC 

BIPH 

BISPPR 

BISPPI 

PHSERR 


frequency  triplet  (sequence  nubmers) 
associated  with  this  bicoherence 

bicoherence 

biphase 

Re  <B'  (co^,a)2)  > 

Im  <B'  (03^,032)  > 

Defined  as  above 


After  listing  individual  bicoherences,  there  is  an 
optional  listing  of  how  the  bicoherences  are  partitioned 
among  bins,  followed  by  the  total  number  of  bicoherences 
submitted.  The  format  is  displayed  in  Appendix  1. 


PHSERR  is  calculated  and  printed  only  above  95%  con¬ 
fidence  level  given  by  SIGLVL  (See  NAMELIST  variable 
table) .  In  the  line  printer  output  shown  in 
Appendix  1,  SIGLVL  =  0.5612. 
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Following  this  there  is  an  optional  display  of 
cuniulative  fractional  numbers  of  total  bicoherence 
lying  below  each  upper  bin  limit.  Again,  the  for¬ 
mat  is  displayed  in  Appendix  1. 

Finally,  when  a  calculation  of  confidence  levels  is 
called  for,  a  summary  of  the  result  for  each  confi¬ 
dence  level  is  displayed  as  in  Appendix  1.  This  is 
followed  by  a  statement  of  the  number  of  bicoherences 
which  happened  to  fall  above  the  limit  used  in  the 
program  (also  stated) . 

(2)  Disc 

Normally  a  consecutive  disc  file  is  produced  by  pro¬ 
gram  BISCAL,  which  is  used  to  transmit  the  computed 
bicoherences  to  program  BPLOT  for  plotting.  The  first 
task  of  program  BPLOT  is  to  construct  from  this  file 
a  two-dimensional  array  whose  elements  occupy  the 
same  relative  position  in  the  matrix  as  do  the  grid 
points  in  the  final  plot.  By  using  the  coding  which 
does  this  (2  statements  for  auto,  or  5  statements  for 
cross —bicoherences )  the  user  can  access  this  file 
directly.  This  will  not  be  delved  into  here,  but 
the  author  can  be  consulted  for  details. 


RESTRICTIONS ; 

1.  The  length  of  the  data  series  which  program  BISCAL 
can  handle  depends  on  the  dimensions  of  OMl,  0M2 ,  and 
array  SQ,  as  well  as  on  how  the  data  series  was^ 
processed  in  the  FOURIER  transform.  The  following 
relations  can  be  used: 

Let  ^  =  data  series  length  adjusted  so  that  2,^ 

is  evenly  divisible  by  L,  the  piece  length 

L  =  piece  length 

D  =  dimensions  of  OMl  and  0M2 

NP  =  number  of  pieces 


50%  overlap 

^  _  L^2D  +  L  +  4 


2  '  L  +  4 

2DL 
L  +  4 


)  and  NP  = 

L 


2'SC 


-  1 


(7) 


and  NP 


(8) 
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In  both  cases  the  number  of  points  in  the  series 
tering  BISCAL  is  (L) (NP) ,  and  OMl,  0M2  must  be 
dimensioned  at  least  (NP) (L/2  +  2) . 


en- 


The  latter  requirement  has  been  incorporated  in  the 
derivation  of  expressions  (7)  and  (8) . 

Example.  Program  BISCAL  has  been  successfully  run 
with  D  =  16400  and  SQ  dimensioned  at  SQ(70,70). 

Assuming  50%  overlap,  eqn.  (7)  above  yields  =  16256 
as  the  maximum  data  series  length  which  could  have 
been  handled.  This  is  subject  to  restriction  (2)  be¬ 
low,  which  requires  that  SQ  should  be  dimensioned  at 
least  SQ(M,M)  where  M  =  L/4  +  1,  a  condition  which  is 
met  here. 

2.  Array  W3  must  be  DIMENSIONed  at  least  2 (NP) . 

3 .  The  dimension  of  array  SQ  must  be  at  least  SQ(M,M) 
where  M  =  L/4  +  1,  L  =  piece  length. 

4 .  Variable  ISQD  must  be  initialized  at  either  dimension  of 
SQ  in  (3)  . 

5 .  L  must  be  an  even  number  with  no  prime  factor  greater 
than  5  and  evenly  divisible  by  4. 

6 .  (No.  of  confidence  levels)  _<  10. 

7.  (No.  of  bins  used  in  sorting  bicoherences)  ^  200. 


STORAGE  AND  CPU  TIME  REQUIREMENTS: 

As  already  mentioned  economy  and  convenience  may  be 
achieved  by  tailoring  the  size  of  the  program  to  the 
user's  needs  if  he  foresees  using  it  for  a  number  of 
data  series  of  somewhat  comparable  length. 

The  following  operating  history  is  provided  to  assist 
ih  this  and  for  general  information: 


Auto  or 

Cross- 

Bicoherence 

Dimensions 
of  OMl/and 
OM2 

Dimensions 
of  SQ 

Piece 

Length 

No .  of 
pieces 

Task 

Peak  core 
(pg  size 
512) 

cpu 

time 

(min) 

Charge 

(CU) 

auto 

5400 

70 

256 

39 

disc  file 

44 

1.895 

3.383 

sorting 

auto 

5400 

70 

256 

39 

disc  file 

44 

1.774 

3.034 

cross 

5400 

70 

256 

39 

disc  file 

44 

n/  6 

^  5.3 
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SUBPROGRAMS  REQUIRED:  None 


ERRORS  AND  DIAGNOSTICS; 

Message  Meaning  Action  Taken 

"(PIECE  LENGTH) /2  MUST  Self-explanatory  abort 

BE  EVEN" 

"CANNOT  HAVE  MORE  THAN  User  has  specified  3  abort 

TWO  INPUT  SERIES"  distinct  logical  files 

for  first  three  entries 
on  Data  Card  1 


PROGRAMMER:  Gerard  H.  Martineau 


ORIGINATOR:  Melbourne  G.  Briscoe 


DATE:  July  1977 


REFERENCES : 

(1)  Report  on  Program  BPLOT,  by  G.  H.  Martineau. 

(2)  "Handbook  for  Computer  Users,"  Information  Processing 
Center  of  W.H.O.I.,  pp.  V-E-1  ff. 

(3)  Report  on  Program  FOURIER,  by  G.  H.  Martineau. 

(4)  "Bispectral  and  Cross-Bispectral  Analysis  of  Wind 
and  Currents  off  Oregon  Coast,"  Ph.D.  Thesis  at 
Oregon  State  University,  by  N.  C.  G.  Yao,  June,  1974. 
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NAME: 


BPLOT 


PURPOSE ;  To  construct  auto  or  cross-bicoherence 

plot  ftom  disc  file  produced  by  program 
BISCAL 


MACHINE :  Xerox  Sigma-7 

SOURCE  LANGUAGE:  FORTRAN  IV 


DESCRIPTION: 

Program  BPLOT  reads  a  consecutive  file  of  auto  or 
cross-bicoherences  produced  by  program  BISCAL  and 
then  makes  a  plot  of  these  bicoherences  over  the 
appropriate  domain. 


USAGE : 


(1) 

Control  cards 

Let 

aaa  =  account  number 
uuu  =  user  number 
fff  =  input  file  name 
ppp  =  plot  file  name 

Assume  element  file  BPLOTR  (object 
account  aaa.  Assume  any  plotting 

of  BPLOT)  is  in 
is  on  Versatec 

or  graphics  terminal.  Then  the  Control  Card  portion 
of  the  input  deck  is: 

!JOB  aaa,uuu 

ILIMIT  (TIME, 2) , (CORE, 38) 
lASSIGN  F:l, (FILE,fff ) 

*! ASSIGN  F:95, (FILE,ppp) , (OUT) , (SAVE) 

!LOAD  (EF, (BPLOTR) , (PLOTDFER,3) ) , (UNSAT, (3) ) 

!RUN 

IDATA 

- >  (DATA  CARDS) 

t ! PLOTV 


*  -  Necessary  only  if  plot  file  is  to  be  saved  after 
this  job. 

t  -  Necessary  only  for  a  Versatec  plot. 
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(2)  Data  Cards 

Program  BPLOT  has  NAMELIST  input  followed  by 
three  data  cards.  The  NAMELIST  input  must  be  terminated 
by  an  *  card  whether  or  not  any  NAMELIST  variables  are 
being  input. 

The  NAMELIST  parameters  and  their  default  values  are 
as  follows: 

NAMELIST  variable  Meaning 

ISTORE  DCB  assignment  for  input  consec¬ 

utive  file 

NDECPL  Format  control  for  axis  annotation:  1 

>0:  Number  of  digits  to  the  right  of 
the  decimal  point  which  are 
plotted,  after  proper  rounding 
=0:  Only  integer  portion  of  number 
and  decimal  point  are  plotted, 
after  rounding 

=-l :  Only  integer  portion  of  number  is 
plotted,  after  rounding 
<-l:  ]nDECPl|-1  digits  are  truncated, 
from  the  integer  portion  after 
rounding 

Width,  in  inches,  of  plot  of  8.75 

L/2  points,  where  L=pc.  length 

Spacing  in  centimeters  be-  WIDTH*2 . 54/ (L/2) 
tween  adjacent  data  (grid)  (L=pc. length) 

points  on  plot.  If  entered 
by  user,  this  will  override 
any  specification  of  variable 
WIDTH 

IHISTORY  Switch  to  include  information  ■  1 

about  data  origin  on  plot;  i.e., 
original  buoy  format  file  names 
and  variable  numbers,  and  to 
print  processing  history  on  plot 
(from  program  FOURIER) 

IHISTORY=l  for  "yes",  0  for  "no" 

The  data  cards  follow  the  *  card  which  terminates 
NAMELIST  input.  They  are  all  in  generalized,  free- 
field  format  and  are  as  follows: 

Card  1 

Meaning 

1  for  auto-bicoherence 

2  for  cross-bicoherence 

piece  length 


Variable  No. 
1 


WIDTH 

CMPPT 


Default 

Value 

1 


2 


99 


BP  LOT 
July  1977 
Page  3 


Card  2 


Variable  No. 


1  (SAMPSEC) 

2  (FREQTIC) 

3  (NCONLV) 

4  thru  (3+NCONLV) 

(4+1'ICONLV)  thru  "1 
(3+2 ‘NCONLV)  J 

Card  3 


Meaning 


Sample  interval  in  seconds 


*Distance  between  tic  marks 
on  plot  in  (hr)~^ 


Niomber  of  contour  levels  to 
follow  (<10) 


NCONLV  contour  levels  for  plot 

NCONLV  confidence  levels 
(percent)  for  contour  levels 


Up  to  72  characters  of  identification,  which  will 
appear  immediately  above  the  plot.  The  first  36 
characters  will  appear  on  one  line,  and  the  next 
36  characters  on  the  next  line.  The  user  is  re¬ 
sponsible  for  a  proper  transition  of  text  from 
one  line  to  the  next,  occurring  between  columns 
36  and  37. 


OUTPUT ; 

(1)  Line  Printer 

Sample  line  printer  output  appears  in  Appendix  1 .  A 
facsimile  of  the  three  input  cards  is  printed,  followed 
by  a  listing  of  the  contour  levels  from  Card  2  under  a 
separate  heading,  "CONTOUR  LEVELS." 

(2)  Plots 

Either  a  disc  plot  file  or  a  Calcomp  plot  tape  cai\  be 
output  by  the  program.  See  Ref.  2  for  tlie  latter.  By 
using  the  ?]:,OTV  or  PLOTC  processor,  Versatec  or  Calcomp 
plots  can  be  produced  either  in  the  same  job  as  BPLOT 
or  separately.  Additionally,  the  Versatec  plot  file 
can  be  displayed  on  a  graphics  terminal  via  the  PIOTT 
processor. 

Two  sample  reduced  Calcomp  nlots  constitute  Appendices  2  and 
which  display  auto  and  cross-bicoherences  respectively. 

The  notation  is  self-explanatory. 


*Full-scale  frequency  (Nyquist  frequency)  is 
1800/SAMPSEC.  Variable  FREQTIC  does  not  have  to 
divide  evenly  into  the  full-scale  frequency. 
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RESTRICTIONS; 

(1)  Program  BPLOT  uses  a  large  two-dimensional  buffer, 

"DATA",  which  can  be  thought  of  as  a  matrix  whose 
elements  correspond  one-for-one  with  the  grid 
points  of  the  plot,  and  whose  rectangular  "boundary" 
completely  contains  the  plot,  the  non-data  points 
being  padded  with  flags  to  that  effect.  The  di¬ 
mensions  of  DATA  therefore  govern  the  maximum  piece 
length  which  can  be  plotted.  The  rule  is  as  fol¬ 
lows:  If  L  is  the  piece  length,  then  array  DATA 

must  be  dimensioned  at  least  DATA(R,C)  where: 

C  >  L/2 
R  ^  1.5C  +  1 

The  "standard"  dimensions  of  DATA  are  DATA (200 , 130) . 
If  recompilation  is  necessary,  then  the  only  other 
change  which  must  be  made  is  to  the  initialization 
of  variables  MDl  and  MD2  in  the  statement  following 
the  DIMENSION  statement.  MDl,  MD2  must  be  the 
fij7st  and  second  dimensions  of  DATA  respectively. 

(2)  The  number  of  contour  levels  must  be  £15. 


SUBPROGRAMS  REQUIRED;  PLOTDFER,  for  a  Versatec  or  graphics 
terminal  plot  file. 


STORAGE  REQUIREMENTS:  In  a  typical  BPLOT  run  in  which^BPLOT 
plus  PLOTDFER  were  loaded,  and  array  DATA  in  BPLOT  was 
dimensioned  DATA  (200,130),  a  peak  core  of  75  512-word  pages 
were  used. 


TIMING;  In  the  run  just  cited,  0.397  min  of  CPU  time  was  used. 


ERRORS  AND  DIAGNOSTICS ;  None 


PROGRAMMER;  GERARD  H.  MARTINEAU 
ORIGINATOR:  MELBOURNE  G.  BRISCOE 


DATE:  July  1977 

REFERENCES;  (1)  Report  on  Program  BISCAL,  by  Gerard  H. 

Martineau,  Woods  Hole  Oceanographic  Inst. 
(2)  Handbook  for  Computer  Users,  Information 
Processing  Center  of  Woods  Hole  Oceano¬ 
graphic  Inst. 


APPENDIX  1 
(BPLOT) 
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13J46  DEC  30i'77  I0«09a9 
J9B  460*1719 

LI^IT  (TImE*2), (C0RE* 38) 

ASSIGN  r:i, (FILE/TIQ9UT) 

ASSIGN  f:95» (FILEiBISCl >/ (^UT)* (SAVE) 

L9AD  (EFi (BOL9TR) , (PL0TDFrR>3) )* (UNSATi  (3) ) 
JPl  ASSOCIATED. 


*  ♦  ALL0CATI9N  SUMMARY  *  • 


PR9TECTT?N  L0CATI9N  PAGES 


DATA  (00) 

AOOO 

3C 

procedure  (01) 

1  lAOO 

DCB  (10) 

11 800 

1 

#«««#####« 

SQN-  IZL 


SIZE»03?*3K  *♦■»*♦* 


********  PReTECTIGN  TYPES;  00  DATA 


01  procedure  10  STATIC 


5EGHI-0  116F9  SEGHI-l  1?54B  SEGHI-J  IISPF 
5EQL0-O  AOOO  SEGL9-1  llAOO  SE3L9-E  IISOO 

00  SIZE*  76FA  01  SIZE-  P4C  10  SIZE-  POO 

RUN 
1  256 

225  0.8  3  .42  *52  .637  95.  99.  99.9 
IWEX  BIOEAST 

ceNTeuR  levels: 

.420  .520  .637 

*ST9P#  MBRMAL  program  CSMolptION 


APPENDIX  2 
(BPLOT) 


FRE02  (CPH) 


APPENDIX  3 
(BPLOT) 
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CROSS  BICOHERENCE 

ORIGINAL  FILE  NAMES:  VARIABLE  NUMBERS: 

FREQUENCY  li  CENRflNOUTPUT  0 

FREQUENCY  2t  GENRRNOUTPUT  0 

FREQUENCY  3i  GENRRNOUTPUT  0 

PROCESSING  HISTORY 

MLF-S  <»N0  nos  MTU  0-3U*5RHf  0-HSU*SflNP  0-fC  SIU  6*1 

«M0  res  10«0L(»f  l-rSWT  l  -CBMICD  17,18  DEC  15. '77 


CONTOUR  LEVELS  AND  PERCENT  CONFIDENCE 

0.400  80.0 

TIME  OF  PLOT:  0.431  85.0 

09:38  DEC  22. '77  ^  gg  g 

0.551  '95.0 
0.675  99.0 


X  =  C8+C16  +  C2il;  Y  =  -S8-S16-Sail:F0RM  XXT 
NYQ=32  HRNNED  S/N=10  FILE  BVPL3 


20 


NAME; 


BISUM 


PURPOSE;  To  integrate  certain  bispectral 

quantities  along  paths  of  constant 
sum  frequency  in  the  -  ^2  plane. 

MACHINE;  Xerox  Sigma- 7 


SOURCE  LANGUAGE;  FORTRAN  IV 


DESCRIPTION; 

Program  BISUM  is  similar  to  the  bispectral  program 
BISCAL,^  and  the  user  is  referred  to  the  report  on 
BISCAL  for  computational  procedures.  The  difference 
in  the  two  programs  is  that  the  sorting  capability 
of  BISCAL  has  been  replaced  in  BISUM  by  summations 
of  bicoherences  and  other  quantitJ es  related  to  bi¬ 
spectra,  over  paths  of  constant  sum  frequencies 
(0)3)  in  the  wi  -  a'2  plane.  The  'paths  are  diagonal 
straight  lines  of  slope  (-1) .  The  summing  is  done 
separately  above  and  below  the  mi  axis;  i.e.,  for 
positive  and  negative  W2.  A  formatted  listing  of 
these  integrals  is  presented.  The  integrals  may 
additionally  be  written  to  a  disc  file.  It  is  also 
possible  to  write  the  same  file  of  bicoherences 
that  is  written  by  BISCAL  for  transmittal  to  the 
plotting  program  BPL0T.2 

INPUT : 

Input  consists  of  the  same  type  of  RWDISC  file  of 
Fourier  coefficients  as  is  used  by  program  BISCAL.^ 


OUTPUT;  (I)  Line  Printer 

A  sample  of  the  printed  output  appears  in  Appendix  1. 
First  the  values  of  all  NAMELIST  variables  are  listed, 
along  with  a  facsimile  of  the  input  data  card.  This 
is  followed  by  a  formatted  list  of  integrals. 

The  integrals  presented  in  the  case  of  calculation  of 
bicoherences  by  Form  1  as  described  in  the  program 
BISCAL  report,  are  as  follows; 
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Let  N  be  the  number  of  points  over  the  path  of 
integration. 


(1) 

(2) 

(3) 

(4) 

(5) 

(6) 

(7) 

(8) 
(9) 

(10) 


BR  :  real  part  of  bispectrum  at 

frequency 

BR/N 

BI  ;  imaginary  part  of  bispectrum  at 

frequency 

BI/N 

BIG  ;  bicoherence ^ 

BIC/N 
(BIG)  ^ 

(BIG) ^/N 

2 

3(0)3)*  (BIG)  where  8(0)3)  square  of  auto¬ 
spectrum  at  frequency  0)3 

(5(0)3)*  (BIG)  ^)/N 


In  the  case  of  calculation  of  bicoherences  of  Form  2 
(from  amplitude-normalized  bispectrum)  in  the  program 
BISGAL  report,  all  of  the  above  quantities  corres¬ 
ponding  to  the  amplitude-normalized  bispectriam  are  cal¬ 
culated,  except  (9)  and  (10)  which  are  listed  as  zero. 


It  will  be  noted  that  both  the  sum  frequency  sequence 
number  (|o)3|)  and  the  number  of  independent  variable 
values  that  enter  each  integral  are  printed  for  each 
line  of  output,  each  line  corresponding  to  a  single 
value  of  1 0J3  I  . 

If  L  is  the  piece  length,  there  are  (L/2-1)  lines  of 
output  for  an  auto-bispectrum  and  twice  that  many 
for  a  cross-bispectrum. 


The  user  may  also  get  a  listing  of  bicoherences  and 
related  quantities  between  limits  which  he  can  set. 
This  listing  is  described  in  the  report  on  program 
BISGAL.^  The  limits  are  set  in  a  data  card  to  be 
described  in  the  "USAGE"  section. 


(II)  Disc 


Two  types  of  disc  files  may  be  written  by  program 
BISUM.  The  first  is  the  same  type  of  file  of  bi¬ 
coherences  written  by  BISGAL^  for  transmittal  to 
plotting  program  BPLOT.  The  second  is  a  consecutive 
file  containing  all  integrals  computed  by  BISUM. 

This  file  is  organized  as  follows  (L  =  piece  length) : 


r  auto- 

cross-  J  bispectrum  *1 
bispectrunn 


I 


j  1  EBGID  header  record  followed  by 
[_(L/2-l)  binary  records  followed  by 
(L/2-1)  binary  records 
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This  file  should  be  read  by  a  FORTRAN  formatted  READ 
statement  (for  the  header  record,  to  fill  an  integer 
array  dimensioned  33) ,  followed  by  one  FORTRAN  binary 
READ  statement  for  each  line  of  printed  output.  Each 
READ  statement  should  read  13  words.  If  the  user 
wishes  to  access  words  1,  2,  or  13,  he  is  notified 
that  these  are  integer  type,  all  others  being  real. 


USAGE ;  (I)  Input  Card  Deck 

1)  Control  Cards 


Let  aaa 
uuu 
INFILE 
OUTBIC 
OUTSUMS 
BISUMR 


account  number 
user  number 

input  file  of  FOURIER  coefficients 
output  file  of  bicoherences 
output  file  of  integrals 
object  file  of  program  BISUM  in 
account  aaa 


The  control  card  deck  can  appear  as  follows: 

!JOB  aaa, uuu 

*  ILIMIT  (TIME, 4) , (CORE, 50) 

! ASSIGN  F:RAD, (FILE , INFILE) , (DIRECT) , (KEYED) 
t  lASSIGN  F:l, (FILE , OUTBIC) , (OUT) , (SAVE) 
ft  lASSIGN  F:2, (FILE, OUTSUMS) , (OUT) , (SAVE) 

ILOAD  (EF, (BISUMR) ) , (UNSAT, (3) ) 

!RUN 

IDATA 

- >  Data  cards 


* 

Core  limit  can  vary  greatly  with  dimension¬ 
ing  of  working  arrays.  See  below. 

t 

Necessary  only  when  outputting  file  of 
bicoherences . 

*t*  i* 

Necessary  only  when  outputting  file  of 
integrals . 

2)  Data  Cards 

Data  card  input  format  is  similar  to  that  for  pro¬ 
gram  BISCAL.^  There  is  NAMELIST  input,  followed 
by  an  *  card  whether  or  not  NAMELIST  parameters  are 
entered,  followed  by  a  single  data  card  in  free- 
field,  generalized  format. 

The  NAMELIST  parameters  follow,  with  their  default 
values.  "Switches"  are  set  to  0  for  "off",  1  for 
"on": 
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Variable 


Meaning 


Default  Value 


MF 


Number  of  logical  files  in  input  21 

RWDISC  file  of  FOURIER  coefficients 


IDATSTART  Location  of  first  word  of  data  in 
each  logical  file  of  input  file 

INORM  Switch  to  calculate  amplitude- 

normalized  bicoherences 


LISTBI 


IDUMP 


ISTORE 


Switch  to  list  bicoherences  and 
related  quantities^  within  user- 
specified  limits 

Switch  to  output  file  of  bicoher¬ 
ences  for  transmittal  to  plotting 
program  BPLOT 

DCB  assignment  for  output  file  of 
bicoherences  created  by  setting 
switch  IDUMP 


KDISC 

KDCB 

IHANN 


Switch  to  output  file  of  integrals 

DCB  assignment  for  output  file  of 
integrals 

Determines  method  of  calculating 
phase  error  when  LISTBI^O  (See  PHSERR 
on  page  12  of  BISCAL  report) . 

IHANN  =  0  not  Hanned  and  not  over¬ 
lapped 

IHANN=1  Hanned  and  overlapped 


SIGLVL  95%  confidence  level  for  bicoherences, 

above  which  phase  error  PHSERR  is 
calculated  and  printed  when  LISTBI=1 


5 

0 

0 


0 


1 


0 

2 

1 


t 


The  single  data  card,  which  follows  the  *  NAMELIST 
terminator  card  has  the  following  entries  in 
free-field,  generalized  format; 


t 


Default  is  an  approximate  value.  If  P  =  number  of  pieces, 
let  the  number  of  degrees  of  freedom  EDOF  be  defined  as 
follows:  2 

EDOF  =  /(19P-1)  for  Hanning,  overlapping 

|^2P  for  no  Hanning,  no  overlapping 

Then  the  default  value  of  SIGLVL  is; 

SIGLVL  =  (6/EDOF)^'^^ 
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Variable  No. 
*1 

*2 

*3 

4 

5 


Meaning 

Logical  file  in  input  RWDISC  file 
associated  with  frequency  03^ 

Logical  file  associated  with  W2 

Logical  file  associated  with  -0)2 

Number  of  pieces  in  input  series  of 
Fourier  coefficients 

Piece  length 


6 

7 


Two  piece  sequence  numbers  between  which 
it  is  desired  to  average,  inclusively 


8 

9 


Lower,  upper  limits  determining  when  to 
print  bicoherence  when  LISTBIt^O.  Bi¬ 
coherences  must  satisfy:  (var.  #9)  < 
bicoherence  <  (var.  #10) 


(II)  Altering  Load  Module  Size 

As  in  BISCAL,  program  BISUM  attempts  to  minimize  disc 
accesses  in  the  same  way.l  This  involves  the  use  of 
two  large  buffers  which  largely  determine  the  size  of 
the  load  module.  There  may  be  worthwhile  benefits  to 
the  user,  in  terms  of  page-minute  charges  and  turn¬ 
around  time,  in  recompiling  the  program  using  buffers 
which  are  no  longer  than  needed. 

The  user  is  therefore  advised  to  recompile  the  program 
to  match  his  needs  if  he  is  going  to  be  handling  a 
number  of  data  series  of  comparable  length.  To  edit 
the  program  prior  to  recompilation,  the  following 
steps  should  be  observed: 

a.  Copy  the  source  file  to  a  duplicate  file,  and  then 
work  with  the  duplicate  file; 

b.  Change  the  DIMENSION'S  of  OMl  and  OM2  arrays  to 

at  least  [(L/2+2)  (NP) ] ,  where  L  =  piece  length  and 
NP  is  the  number  of  pieces. 


If  variables  1,  2,  3  are  all  equal,  then  auto-bispectra 
will  be  computed  and  the  minimum  necessary  doman  will 
be  used. 
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c.  Check  that  array  W3  is  DIMENSIONed  at  least 
2 (NP)  . 

d.  Check  that  SQ  is  DIMENSIONed  at  least 
SQ(L/4  +  1,  L/4  +  1)  (both  dimensions 
identical) . 

e.  Check  that  the  initialization  of  variable  ISQD 
is  identical  to  both  dimensions  of  SQ. 

f.  There  are  ten  arrays  used  to  accumulate  sums 
of  bicoherences  and  related  quantities.  These 
must  be  all  DIMENSIONed  at  least  (L/2) . 

The  arrays  are  BRU,  BIU,  BICU ,  BIC2U,  BCSU , 
BRL,  BIL,  BICL,  BIC2L,  and  BCSL. 

g.  Variable  JDIM  must  be  initialized  at  the 
dimension  of  the  arrays  in  (f ) . 

h.  Recompile. 


A  further  reduction  in  size  of  the  program  can  be 
achieved  if  the  user  does  not  wish  to  produce  a  file 
of  bicoherences.  Array  SQ  has  two  equal  dimensions, 
which  must  be  at  least  (L/2+1)  if  this  file  is 
produced.  If  there  is  to  be  no  file  of  bicoherences, 
then  SQ  can  be  dimensioned  SQ{2,2).  Variable  ISQD 
must  be  initialized  at  one  of  the  dimensions  of  SQ. 


RESTRICTIONS: 


1.  The  length  of  the  data  series  which  program  BISUM 
can  handle  depends  on  the  dimensions  of  OMl,  0M2,  and 
array  SQ,  as  well  as  on  how  the  data  series  was  processed 
in  the  FOURIER  transform.  The  following  relations  can 
be  used: 

Let  ^  =  data  series  length  adjusted  so  that  2  ^  is 
evenly  divisible  by  L,  the  piece  length 

L  =  piece  length 

D  =  dimensions  of  OMl  and  0M2 

NP  =  number  of  pieces 


50%  overlap 


2D  +  L  +  4> 
L  +  4  ‘ 


and  NP 


2DL 


(1.) 


L  +  4 


and  NP 


L 


(2.) 
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In  both  cases  the  number  of  points  in  the  series 
entering  BISUM  is  (L) (NP) ,  and  OMl,  0M2  must  be 
dimensioned  at  least  (NP)  {L/2  +  2)  . 

The  latter  requirement  has  been  incorporated  in 
the  derivation  of  expressions  1.  and  2. 

Example.  Program  BISUM  has  been  successfully  run 
with  D  =  16400  and  SQ  dimensioned  at  SQ(70,70). 
Assuming  50%  overlap,  Eq.  (7)  above  yields 
^  =  16256  as  the  maximum  data  series  length  which 
could  have  been  handled.  This  is  subject  to  re¬ 
striction  (2)  below,  which  requires  that  SQ  should 
be  dimensioned  at  least  SQ(M,M)  where  M  =  L/4  +  1, 
a  condition  which  is  met  here. 

2.  Array  W3  must  be  DIMENSIONed  at  least  2 (NP) . 

3 .  The  dimension  of  array  SQ  must  be  at  least  SQ(M,M) 
where  M  =  L/4  +  1,  L  =  piece  length. 

4 .  Variable  ISQD  must  be  initialized  at  either  dimen¬ 
sion  of  SQ  in  (3) . 

5.  The  arrays  used  to  accumulate  sums  of  bicoherences 
and  related  quantities  must  all  be  DIMENSIONed  at 
least  (L/2).  These  arrays  are  BRU,  BIU ,  BICU, 
BIC2U,  BCSU,  BRL,  BIL,  BICL,  BIC2L,  and  BCSL. 

6 .  Variable  JDIM  must  be  initialized  to  the  dimen¬ 
sion  of  the  arrays  in  ^ 

7 .  L  must  be  an  even  number  with  no  prime  factor 
greater  than  5,  and  evenly  divisible  by  4. 


SUBPROGRAMS  REQUIRES:  None 


ERRORS  AND  DIAGNOSTICS: 

Action 
Taken 


Abort 


Three  distinct  log¬ 
ical  files  have  been 
referenced  by  first 
three  entries  on  data 
card 


Message 

"(PIECE  LENGTH) /2  MUST  BE  EVEN" 


Meaning 

Piece  length  must 
be  evenly  divisible 
by  four 


CANNOT  HAVE  MORE 
INPUT  SERIES" 


THAN  TWO 


Abort 


PROGRAMMER; 

ORIGINATOR; 

DATE; 

REFERENCES ; 
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BISUM 
July  1977 
Page  8 


GERARD  H.  MARTINEAU 

MELBOURNE  G.  BRISCOE 
July,  1977 


1.  Report  on  Progrqm  BISCAL,  by  G.  H. 
Martineau,  Woods  Hole  Oceanographic 
Institution. 

2.  Report  on  Program  BPLOT,  by  G.  H. 
Martineau,  Woods  Hole  Oceanographic 
Insitution . 


APPENDIX  1 
(BISUM) 


15518  JAN  26# '78  ID-0A62 
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LIMIT  {TlME#a)# (C0RE#35)/ (9RDPR)# ( ACCQUNT) 
ASSIGN  FIRAD#  (FILE#  BVECID#  (DIRECT)#  (KEYED) 
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•STOP*  NBRMAL  PROGRAM  COMPLETION 


NAME: 


BIVEC 


TYPE :  Main  Program 


PURPOSE  I  To  calculate  auto  and  cross  rotary  bispectra 

of  two  vector  series,  to  write  disc  files  of 
rotary  bicoherences  for  transmittal  to 
plotting  program  RBPLOT, d)  and  to  compute 
confidence  levels  for  the  rotary  bicoherences. 


I4ACHINE ;  Xerox  Sigma-7 


SOURCE  LANGUAGE;  FORTRAN  IV 


DESCRIPTION; 

Program  BIVEC  uses  as  input  an  RWDISC(2)  file  of  Fourier 
coefficients  having  a  particular  order  to  be  described 
below.  These  coefficients  are  assumed  to  result  from 
two  real  data  series  per  vector  series,  the  real  series 
constituting  the  scalar  components.  The  coefficients 
are  normally  the  output  of  program  FOURIER, (3)  which 
has  done  any  necessary  prewhitening,  subsampling,  over¬ 
lapping,  mean  and  trend  removal,  and  Hanning. 

If  L  is  the  piece  length  and  P  is  the  niimber  of  pieces 
resulting  from  program  FOURIER,  there  are  2-LP  words 
input  into  BIVEC  for  each  vector  data  series.  Program 
BIVEC  computes  approximately  (3/2)(L/2)2  values  of  auto 
rotary  bicoherence,  or  either  (3/2) (L/2) 2  or  3(L/2)2 
values  of  cross  rotary  bicoherence,  the  latter  depending 
on  the  combination  of  sources  of  data.  A  normalization 
of  rotary  bicoherences  by  amplitude  can  be  specified 
(see  below) .  Corresponding  rotary  biphase  and  rotary 
biphase  error  are  also  computed  if  desired.  In  normal 
use,  program  BIVEC  writes  consecutive  files  of  rotary 
bicoherences  on  the  disc  to  be  used  as  input  to  plotting 
program  RBPLOT.  The  user  can  instruct  the  program  to 
list  rotary  bicoherences  and  related  quantities  when  the 
rotary  bicoherences  fall  between  limits  set  by  the  user. 
Finally,  a  listing  of  partitioning  of  rotary  bicoherences 
into  bins  of  specified  size  can  be  obtained,  as  well  as 
a  list  of  rotary  bicoherences  which  correspond  to  speci¬ 
fied  confidence  levels. 
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COMPUTATIONS  PERFORMED; 


I.  Rotary  Bispectra 

The  default  definitions  of  rotary  bispectrum,  rotary 
bicoherence,  and  rotary  biphase  used  by  program  BIVEC 
are  those  given  by  N.  C.  G.  Yao.  (4) ,  (5)  From  two 
real  series,  ui(t)  and  U2 (t) ,  construct  the  complex 
vector  series  3(t)  =  U]^(t)  +  iu2  (t)  .  Let  oo  be  the 
angular  velocity  of  2(t)  and  let  a  =  luj.  Further  let 
A2^{w),  B]^(w)  be  the  cosine  and  sine  Fourier  coeffi¬ 
cients  of  real  series  U]^(t)  and  A2(w),  B2  (w)  be  the 
corresponding  quantities  for  real  series  U2 (t) . 

One  can  represent  the  vector  series  u(t)  by 


•  •  ■ 

u(t)  =  u  (t)  +  iu  (t)  =  I  (U^(a)e^^^  +  U_(a)e”^‘^^) 

where  the  coefficients  U+(c)  and  U_(a)  are  called  by 
Yao  "rotary  Fourier  coefficients,"  and  they  correspond 
respectively  to  positive  and  negative  angular  frequencies 
present  in  the  vector  series  u(t).  Yao  shows  that  U^(a) 
and  U_(a)  are  given  by: 

U^(a)  =  [A^{a)  +  B2(a)]  +  i[A2(a)  -  B^(a)];  w  =  a 

U_(a)  =  [A^(a)  -  B2(a)]  +  i[A2(cr)  +  B^(a)];  w  =  -a 

in  terms  of  Fourier  coefficients  of  the  component  real 
series . 

The  rotary  spectrum  <P(a))d()0>  is  then  defined  as; 

<P(w)dw>  =  <U  (Wj^)U*  (0^2)  >  when  =  0)2 

(1) 

=  0  when  /  0^2 

2 

and  the  rotary  bispectriam<RB(w^,a)2)dco  >  as 
<RB(to^,aj2)dw^>  =  <U  (a)^)U  (a)2)U*  (0)3)  when  +  002  =  “3 


when  +  0^2  ^  W3 


C2) 
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where  U(w)  represents  U+(a)  or  U_(a)  depending  on  the 
sign  of  00.  In  the  largest  frequency  domain  of  interest 
(see  below)  there  will  be  six  possible  interpretations 
of  equation  (2)  in  terms  of  magnitude  a. 

The  rotary  bicoherence  Rbic  (oo^/oo^)  is  defined  as: 

2 

I  <RB  (<1)2  /a)2)  doa  >  | 

Rbic  (oj,  ,00^)  =  - o  -[  (3) 

^  [<P(w^)><P(w2)><P(w3)>dw-^]  / 

and  the  rotary  biphase  R(})  (00^,002)  as: 

2 

Im<RB  (00^,002)  do)  > 

Rcj)  (00, /OO-)  =  tan  - ^ 

^  Re<RB(a)^,oo2)doo  > 

If  P  is  the  number  of  pieces,  the  averaging  procedure 
indicated  in  equations  (1)  and  (2)  leads  to: 

p 

P^/^1  \  RBj^  (00^,032)^00^  I 

Rbic  (03^,032)  =  -p - ^ - p -  —  ( 

[  y  P  (oo^)doo  y  P,  (oo-)do3  P  (o3-3)da3] 

k=l  ^  ^  k=l  ^  k=l 


where  k  identifies  each  piece. 

Alternate  form  of  rotary  bicoherence 

Program  BIVEC  can  compute  an  alternate  form  of  rotary 
bicoherence  based  on  the  following  definition  of  rotary 
bispectrum  normalized  by  its  amplitude: 

2 

-  /  RB,  (03  ,  03  „)  doj  \ 

<RB'  (00,  ,03„)d03^>  =(  - - - o-  )  (6) 

^  \  I  RBj^  (00^,032)  do3  I  / 

2 

where  RB  (00,  ,  03„ )  doo  is  given  by  equation  (2)  applied  to 
<  1  K.  JL  ^ 

piece  k. 

Using  this  definition,  the  piece-averaged  rotary  bi¬ 
coherence  is  now: 
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Rbic  '  (ca^,t02)  =  ]  <RB  '  ^1 

2  (7) 

^  P  RBj^  (a)^,t02)  dw 

^  k=l  I  RBj^  (w^,0J2)  dto^  I 


Frequency  domain 


As  stated  above,  program  BIVEC  can  operate  on  one  or  two 
vector  series.  Let  the  first  be  represented  by  X  and  the 
Second  by  Y.  Let  the  juxtaposition  of  three  symbols  from 
the  set  {X,Y}  refer  to  a  particular  choice  of  sources  for 
Fourier  coefficients  of  frequency  W]_,a)2/W3  respectively. 

It  can  be  shown  that  there  are  only  four  distinct  rotary 
bispectra  that  can  be  calculated  from  the  two  vector 
series  X  and  Y: 

Ij  auto  rotary  bispectrum  for  XXX 

2)  auto  rotary  bispectrum  for  YYY 

3)  cross  rotary  bispectrum  for  XXY 

4)  cross  rotary  bispectrum  for  XYY 

It  can  further  be  shown  that  it  is  not  necessary  to  let 
the  constituent  frequencies  range  over  all  possible  values. 
The  minimum  necessary  domain  for  cases  1),  2),  3)  is: 


{A}  =  {(la)^|  >  |u32l)  n  (-L/2  <  <  L/2) 


where  033  =  001  +  u)2,  L  is  the  piece  length,  and  o)  is  ex¬ 
pressed  in  units  of  cycles  per  point.  Pictorially,  this 
is  the  unshaded  area  in  figure  1.  For  case  (4),  however, 
it  is  necessary  to  approximately  double  this  domain  so  that 
the  shaded  area  in  figure  1  is  also  included.  The  minimum 
necessary  domain  is  now: 


{A'}  =  {(-L/2  <  <  L/2)r\  (-L/2  <  0^2  - 

(-0)^  -  L/2  1  0)2  1  -0J3_  +  L/2)  /  0)  A  (0)2  Z  -o)^)  > 
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Order  of  the  computations 

Program  BIVEC  can  handle  two  vector  data  series,  each 
consisting  of  two  scalar  series  each  of  length  16  K 
words.  This  means  that  for  50%  overlap  and  for  the 
limiting  case  of  an  infinite  number  of  pieces,  each 
vector  series  entering  the  program  consists  of  64K 
Fourier  coefficients.  In  order  to  permit  computation 
of  the  bispectra,  and  to  minimize  the  number  of  disc 
accesses,  the  following  steps  are  taken: 

1)  Organization  of  input  file 

Let  {aj[}  be  the  set  of  all  real  parts  of  the 
i^h-frequency  Fourier  coefficient  taken  over 
all  pieces,  and  let  {bj^}  be  the  corresponding 
imaginary  parts.  Then,  for  a  piece  length  of 
L,  the  input  file  elements  have  the  following 
order : 

2  ■  ^ 

{b  } ,  {a  }  . 

1j  _  1  1j 


The  elements  of  b,.  are  all  zero  and  do  not 

JL 

2 

appear  in  the  input  file.  Program  FOURIER  (3) 
automatically  outputs  coefficients  in  this  order. 
This  permits  all  elements  associated  with  a  given 
frequency  to  be  input  by  entering  the  series 
only  once. 
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2)  Organization  of  frequency  domain  and  computation 
procedure 

Figure  2  is  a  representation  of  1/4  of  the  maximum 


This  area  is  shown  divided  into  16  sub-domains 
or  "rasters."  Program  BIVEC  calculates  rotary 
bispectra  for  each  raster  in  the  order  of  numbering 
in  fig.  2.  Simultaneous  with  this  calculation,  is 
computation  of  rotary  bispectra  for  the  raster  which 
is  symmetric  about  the  origin,  having  sum  frequency 
W3  of  opposite  sign,  and  which  uses  the  same  set 
of  Fourier  coefficients.  In  this  way,  there  are 
no  more  than  LP/4  elements  from  each  component 
scalar  series  in  core  at  any  time,  where  L  =  piece 
length,  P  =  number  of  pieces.  The  reading  of 
series  "quarters"  from  the  disc  is  a  function  of 
each  particular  combination  of  source  series,  an 
attempt  being  made  to  exploit  symmetries  for  maxi¬ 
mum  efficiency.  Within  each  raster,  computations 
are  done  from  upper  left  to  lower  right  along 
diagonal  scans  of  slope  (-1),  each  scan  thus  cor¬ 
responding  to  a  single  sum  frequency  .  The  disc 
is  accessed  for  the  coefficients  of  frequency  103 
only  when  these  coefficients  are  not  already  avail¬ 
able  in  core. 

Computations  over  the  shaded  area  of  fig.  1  are  done 
similarly . 

II.  Confidence  Levels 


As  each  rotary  bicoherence  is  computed,  the  user  may  elect 
to  assign  it  to  a  bin  having  a  size  of  his  choice.  The 
user  may  also  determine  the  number  of  bins  by  specifying 
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the  upper  rotary  bicoherence  limit  to  be  considered. 

After  this  sorting  has  been  done,  program  BIVEC  determines 
the  rotary  bicoherences  below  which  specified  fractions 
("confidence  levels")  of  the  total  number  or  rotary  bi¬ 
coherences  calculated  by  the  program  lie.  This  is  done 
by  calculating  the  fraction  of  the  total  which  lies  be¬ 
low  the  upper  limit  of  each  bin,  finding  the  two  closest 
such  fractions  which  "bracket"  the  specified  confidence 
level,  and  linearly  interpolating  the  two  corresponding 
rotary  bicoherences  to  find  the  one  which  corresponds  to 
the  specified  confidence  level.  A  dump  of  the  distribu¬ 
tion  is  available. 

USAGE: 

(1)  Tailoring  load  module  size 


For  long  series  of  Fourier  coefficients,  it  is  desirable 
to  have  large  data  buffers  to  keep  disc  accesses  to  a  min¬ 
imum.  On  the  other  hand  these  large  data  buffers  can  be 
wasteful  for  shorter  series  both  in  terms  of  (page-minutes) 
charges  and  the  penalty  in  turnaround  time.  The  user  is 
therefore  advised  to  consider  recompiling  the  program  to 
match  his  needs  if  he  is  going  to  be  handling  a  number  of 
data  series  of  comparable  length.  To  edit  the  source  pro¬ 
gram  prior  to  recompilation,  the  following  steps  should 
be  observed: 

1.  Copy  the  source  file  to  a  duplicate  file,  and  then 
work  with  the  duplicate  file; 

2.  Change  the  DIMENSIONS  of  Wll,  W12,  W21,  W22  to  at 
least  LP/4,  where  L  =  piece  length  and  P  is  the 
number  of  pieces. 

3.  Make  the  first  dimension  of  OM  exactly  the  same  as  in  (2) 

4.  Check  that  arrays  W31  and  W32  are  DIMENS lONed  at  least  2P 

5.  Check  that  SQl  and  SQ2  are  DIMENSIONed  at  least  (L/8, 
L/8),  both  arrays  identically. 

6.  Check  that  the  initialization  of  variable  ISQD  is  iden¬ 
tical  to  either  dimension  in  (5) ,  and  that  ISOM  is 
initialized  at  exactly  the  dimensions  in  (2) . 

7.  Recompile. 

(2)  Control  Cards 


Let  aaa  =  account  number 
uuu  =  user  number 

fff  =  input  file  name  (RWDISC,  keyed) 
ttii  =  file  names  for  transmittal  to  plotting 
program  (consecutive  files) 
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Assume  the  element  file  is  called  BIVECR  and  exists 
in  account  aaa.  The  Control  Card  portion  of  the  in¬ 
put  deck  is  then  as  follows; 

!JOB  aaa,uuu 

*  ILIMIT  (TIME, 10) , (CORE, 30) 

lASSIGN  F:RAD,  (FILE,fff),  (DIRECT) , (KEYED) 
t  ! ASSIGN  F:l,  (FILE,ttll),  (OUT) , (SAVE) 
t  lASSIGN  F:2,  (FILE,tt22),  (OUT) , (SAVE) 
tt  lASSIGN  F: 3,  (FILE,tt33),  (OUT) , (SAVE) 
tt  lASSIGN  F:4,  (FILE,tt44),  (OUT) , (SAVE) 

ILOAD  (EF, (BIVECR) ) ,  (UNSAT, (3)) 

IRUN 

IDATA 

(DATA  CARDS) 

(3)  Data  cards 

Program  BIVEC  has  NAMELIST  input  followed  by  one  or 
two  data  cards  depending  on  the  application.  The 
NAMELIST  input  must  be  terminated  by  an  *  card  whether 
or  not  any  NAMELIST  variables  are  being  input. 

The  NAMELIST  parameters  and  their  default  values  are 
as  follows.  In  general  the  switches  are  to  be  set  to 
0  for  "off"  and  1  for  "on". 


Time  and  core  limits  will  vary  widely  depending  on 
application.  See  below. 

^Necessary  only  when  storing  bicoherences  on  disc, 
for  transmittal  to  plotting  program.  DCB  assignments 
may  be  changed  by  NAMELIST  parameters  ISTOREl  and 
ISTORE2  respectively. 

^^Must  be  included  along  with  DCB  assignments  mentioned 
in  footnote  t,  when  doing  cross  rotary  bispectrum 
for  case  XYY  and  transmitting  bicoherences  via  disc 
to  plotting  program.  May  be  changed  by  NAMELIST 
parameters  ISTORE3  and  ISTORE4  respectively. 
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NAMELIST  VARIABLE  MEANING  DEFAULT  VALUE 


MF 

I DATS TART 

LISTBI 

SIGLVL 

IDUMP 

I STORE 1 
I STORE 2 

I STORE 3 
ISTORE4 

INORM 

LABREAD 


Number  of  logical  files  in  21 

input  RAD  file 

Starting  location  of  data  5 

in  each  input  logical  file 

Switch  to  list  rotary  bi-  0 

coherences  and  associated 
quantities 

95%  confidence  level  for  ro-  * 

tary  bicoherences,  above  which 
phase  error  PHSERR  is  calcu¬ 
lated  and  printed  when 
LISTBI=1 


Switch  to  store  rotary  bi-  1 

coherences  in  a  consecutive 
file  for  transmittal  to 
plotting  program 

DCB  assignments  for  consecu-  1 

tive  files  of  rotary  bico-  2 

herences  created  by  setting 
switch  IDUMP.  Applies 
always 

Like  ISTOREl  and  IST0RE2 ,  3 

except  that  these  apply  only  4 

for  cross  rotary  bispectrum 
in  the  case  XYY 

Sets  amplitude  normalization  0 

described  above 

Switch  to  read  labels  for  each  1 


series  in  input  RWDISC  file 
and  to  write  these  labels  to 
output  files  for  use  by  the 
plotting  program.  Each  label 
consists  of  original  buoy 
file  name  and  variable  number. 
If  not  set,  then  EBCDIC  blanks 
will  be  written  to  output  file 


Default  is  an  approximate  value.  If  P  =  number  of 
pieces,  let  the  number  of  degrees  of  freedom  EDOF  be 
defined  as  follows; 

(  36P^/(19P-1)  for  Hanning,  overlapping 


EDOF  =  < 


2P 


for  no  Hanning,  no  overlapping 


Then  the  default  value  of  SIGLVL  is 


1/2 


SIGLVL  =  (6 /EDOF) 
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NAMELIST  VARIABLE  MEANING 


DEFAULT  VALUE 


IFOURIER 


KONF 

IHANN 


BINSIZE 


RBICLIM 


KBl 

KB2 


Switch  to  read  132  character  1 

label  in  input  file  describ¬ 
ing  processing  done  by  pro¬ 
gram  FOURIER  and  to  write 
these  labels  to  output  files 
for  use  by  the  plotting  pro¬ 
gram.  If  not  set,  then 
EBCDIC  blanks  will  be  written 
to  output  file 

Switch  for  determining  rotary  0 

bicoherence  confidence  levels 

Determines  method  of  calculat-  1 

ing  phase  error  when  LISTBl/0 
(See  PHSERR,  page  13) 

IHANN=0  not  Banned  and  not 
overlapped 

IHANN=1  Banned  and  overlapped 

Bin  width  for  sorting  rotary  0.01 

bicoherences.  A  given  rotary 
bicoherence  is  placed  in  bin  I, 
where  I  =  INT  (rot.  bicoh./ 

BINSIZE)  +  1 

The  rotary  bicoherence  "limit"  1.5 

for  sorting  which  determines 

the  number  of  bins  of  size 

BINSIZE,  by  determining  the 

integer  NBINS  obtained  by 

rounding  (RBICLIM/BINSIZE) , 

and  then  redefining  RBICLIM 

as  (NBINS)X (BINSIZE) 

Switch  to  display  partition-  1 

ing  of  rotary  bicoherences 

Switch  to  display  fraction  of  1 

total  rotary  bicoherences 
under  each  bin  limit 


The  data  cards  follow  the  *  card  which  terminates  NAMELIST 
input.  They  are  all  in  generalized,  free-field  format  and 
are  as  follows : 
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Card  1  (Mandatory) 


Variable  No. 


Meaning 


*  * 


Logical  file  for  1st  scalar  component  of 
1st  vector  series 

Logical  file  for  2nd  scalar  component  of 
1st  vector  series 

Logical  file  for  1st  scalar  component  of 
2nd  vector  series 

Logical  file  for  2nd  scalar  component  of 
2nd  vector  series 

Logical  file  of  1st  scalar  component  for 
sum  frequency  series 

Logical  file  of  2nd  scalar  component  for 
sum  frequency  series 

Total  number  of  pieces  in  each  series 
Piece  length 

Lower,  upper  piece  sequence  numbers  inclusive, 
between  which  user  wants  to  average 

Lower,  upper  limits  determining  when  to  print 
rotary  bicoherences  when  LISTBI/0.  Rotary 
bicoherences  must  satisfy: 

(var.  #11)  <  rotary  bicoherence  _<  (var.  #12) 


Card  2  (Input  only  when  KONF/0) 


Variable  No.  Meaning 

1  (NCONF)  Number  of  confidence  levels  to  follow  (£10) 

2  (CONF)  NCONF  confidence  levels  expressed  as 

decimal,  0  to  1 


The  user  must  take  care  to  use  no  more  than  two  dis¬ 
tinct  vector  series  or  the  program  will  not  proceed. 

Two  vector  series  are  distinct  unless  both  1st  and 
2nd  scalar  component  series  are  respectively  identical. 
The  program  automatically  determines  the  form  of 
rotary  bispectr.um  discussed  under  "Frequency  Domain," 
as  well  as  the  corresponding  frequency  domain. 

*  * 

Piece  length  must  be  evenly  divisible  by  8,  have  no 
prime  factor  greater  than  5,  and  be  no  greater  than 
4000.  Appendix  2  is  a  list  of  permissible  choices. 
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OUTPUT ; 

(1)  Line  Printer 

Typical  line  printer  output  is  displayed  in  Appendix  1. 
First  a  dump  of  NAMELIST  parameter  values  is  printed, 
followed  by  a  facsimile  of  input  data  cards.  Next,  if 
confidence  levels  are  called  for ,  the  "adjusted  rotary 
bicoherence  limit"  (as  determined  by  the  rule  given  in 
describing  variable  RBICLIM  in  the  section  on  Data  Cards 
above)  is  printed. 

This  is  followed  by  a  listing  of  individual  rotary  bi¬ 
coherences  if  called  for.  There  is  one  rotary  bicoherence 
value  per  line,  plus  other  output  described  below.  The 
listing  occurs  only  within  the  limits  given  by  variables 
#11  and  #12  on  Card  1,  and  the  order  is  the  order  of 
computation.  Every  positive  sum  frequency  considered 
is  followed  by  the  corresponding  negative  sum  frequency. 
The  user  is  cautioned  that  for  cross  rotary  bicoherences 
of  form  XYY,  the  total  number  of  rotary  bicoherences 
computed  is  about  3(L/2)^,  which  is  nearly  50000  for  a 
piece  length  of  256.  Without  sufficiently  narrow  limits 
on  the  rotary  bicoherences  actually  printed,  this  can 
result  in  a  prohibitively  large  number  of  output  pages. 


The  items  output  in  each  line  depend  on  which  form  of 
rotary  bicoherence  is  called  for  in  the  program.  They 
are  as  follows,  in  order  of  appearance  from  left  to 
right  on  the  line; 


(A)  Default 

rotary  bicoherence  (after  Yao) ; 

Variable 

Meaning 

FI  F2  F3 

Frequency  triplet  (sequence  numbers) 
with  the  rotary  bicoherence 

RBIC 

Rotary  bicoherence 

RBPH 

Rotary  biphase 

RNUM 

RBR 

2 

<Real  [RB(w^,t02)dw  J  > 

RBI 

2 

<Imag  [RB  (  ,  W2 )  d  w  ]> 

PI 

<P(i03^)du)> 

P2 

<P  ( (j02)d(jj> 

P3 

<p(w^)di^> 

associated 
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Variable 

RDEN 

PHSERR* 


Meaning 


1  /2 

[<P  (u^)  dwxP  {^2 )  dcaxp  )  dw>]  ' 


Phase  error;  depends  on  IHANN  (see  page  9) 

=  /2P  for  IHANN=0,  P  =  No.  of  pieces 

=  57.296  sin"l  [ 1 . 96/ (RBIC • W) ]  for  IHANN=1 
default  where  W  =  [36p2/ (19P-1) ] 

(B)  Alternate  rotary  bicoherence  (normalized  by  amplii;ude) 


Variable 
Fl  F2  F3 

RBIC 

RBPII 

RBR 

RBI 

PHSERR 


Meaning 

Frequency  triplet  (sequence  numbers)  associated 
with  this  rotary  bicoherence 

Rotary  bicoherence 

Rotary  biphase 

2 

<Real  [RB  '  (oj^ ,  CO2 )  d'W  ]> 

<Imag  [RB '  (w^ , 0^2) doo^ ]  > 

Defined  as  above 


After  listing  individual  rotary  bicoherences,  there  is  an 
optional  listing  of  how  the  rotary  bicoherences  are  parti¬ 
tioned  among  bins,  followed  by  the  total  number  of  rotary 
bicoherences  submitted.  The  format  is  displayed  in 
Appendix  1 . 

Following  this  there  is  an  optional  display  of  cumulative 
fractional  numbers  of  rotary  bicoherences  lying  below  each 
upper  bin  limit.  Again,  the  format  is  displayed  in 
Appendix  1. 

Finally,  when  a  calculation  of  confidence  levels  is  called 
for,  a  summary  of  the  result  for  each  confidence  level  is 
displayed  as  in  Appendix  1.  This  is  followed  by  a  statement 
of  the  number  of  rotary  bicoherences  which  happened  to  fall 
above  the  limit  used  in  the  program  (also  stated) . 

(2)  Disc 

Normally  two  or  four  consecutive  disc  files  are  produced  by 
program  BIVEC,  as  explained  above,  which  are  used  to  trans¬ 
mit  the  computed  rotary  bicoherences  to  the  plotting  programs 
These  files  also  contain  information  about  the  origin  of  the 
data  series,  the  processing  history,  and  the  organization  of 
the  input  file  of  Fourier  coefficients. 


PHSERR  is  calculated  and  printed  only  above  95%  confi¬ 
dence  level  given  by  SIGLVL  (see  NAMELIST  variable 
table) .  In  the  line  printer  output  shown  in  Appendix  1 
SIGLVL=0. 5612. 
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Each  output  consecutive  disc  file  is  organized  as  follows: 
Words ^  inclusive  Number  of  Words  Meaning 


1  thru  N 
N+1  thru  N+3 

N+4 


N  N  rotary  bicoherences 

3  Buoy  format  file  name  for 

source  of  variable  1,  Card  1 

1  Buoy  format  variable  number 

for  source  of  variable  1, 
Card  1 


N+5  thru  N+24 


20  Like  words  N+1  thru  N+4, 

for  variables  2  thru  6, 
Card  1 


fj+25  1  No,  of  logical  files  in  in¬ 

put  RWDISC  file  (usually  21) 

N+26  thru  N+58  33  Processing  history  from  pro¬ 

gram  FOURIER 

The  first  task  of  the  plotting  program  is  to  construct  from 
each  consecutive  file  of  rotary  bicoherences  a  two-dimensional 
array  whose  elements  occupy  the  same  relative  position  in 
the  matrix  as  do  the  grid  points  in  the  final  plot.  By  using 
the  coding  which  does  this  the  user  can  access  this  file 
directly.  The  author  can  be  consulted  for  details. 


RESTRICTIONS: 

1.  The  length  of  the  data  series  which  program  BIVEC 
can  handle  depends  on  the  dimensions  of  arrays  Wll, 
W12,  W21,  W22  (see  "USAGE") ,  as  well  as  on  how  the 
data  series  was  split  when  processed.  There  is  an 
upper  limit  of  16K  words  on  the  data  series  length, 
or  32K  words  on  the  length  of  the  resulting  Fourier 
coefficient  series  entering  BIVEC.  By  "data  series" 
is  meant  each  component  series  of  each  vector  series, 
so  that  128K  Fourier  coefficients  can  actually  be 
used . 

Let 

L  =  maximum  length  of  data  series.  2L  is 
assumed  to  be  an  exact  multiple  of  L, 
the  piece  length,  for  50%  overlap  and  L 
is  assumed  to  be  an  exact  multiple  of  L 
for  no  overlap. 

L  =  piece  length 

D  =  dimensions  of  the  arrays  WIJ 

P  =  no.  of  pieces 
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50%  overlap 

L  =  (4D+L)/2  and  P  =  2L/L-1  (8) 

No  overlap 

L  =  4D  and  P  =  L/L  (9) 

In  all  cases  the  number  of  points  in  the  Fourier  coef¬ 
ficient  series  entering  BIVEC  is  PL,  and  the  four  WIJ 
arrays  mentioned  above  must  be  dimensioned  at  least 
PL/4. 

2.  The  first  dimension  of  OM  must  be  exactly  the  dimension 
of  WIJ  arrays  mentioned  in  (1) . 

3.  The  arrays  W31  and  W32  must  be  dimensioned  at  least  2P, 
where  P  =  no.  of  pieces. 

4.  The  arrays  SQI ,  1=1,2  must  be  dimensioned  at  least 
SQI(M,M)  where  M  =  L/8 ,  L  =  piece  length. 

5.  Variable  ISQD  must  be  initialized  to  either  dimension 
of  the  arrays  SQI(M,M)  mentioned  in  (4).  Variable  ISOM 
must  be  initialized  at  exactly  the  dimension  of  the 
arrays  WIJ  mentioned  in  (1)  . 

6.  L  must  be  evenly  divisible  by  8,  have  no  prime  factor 
greater  than  5,  and  be  ^4000. 

7.  (No.  of  confidence  levels  )  £10. 

8.  (No.  of  bins  used  in  sorting  rotary  bicoherences)  £200 


ERRORS  AND  DIAGNOSTICS: 


Message 


Meaning 


Action 

Taken 


"LAST  PIECE  TO  AVG .  GREATER  Self-explanatory  Abort 

THAN  NO  OF  PCS" 


NO  MORE  THAN  TWO  DIFFERENT 
VECTOR  SERIES  ALLOWED" 


(Based  on  choice  of  logi¬ 
cal  files  in  input  RWDISC 
file) .  Vector  series  are 
different  unless  both  com¬ 
ponent  series  are  the  same 


"TWO  OUTPUT  DCB's  HAVE  BEEN  Self-explanatory 
SET  EQUAL  CAN'T  DO" 


Abort 


Abort 
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PIECE  LENGTH  MUST  BE  FROM 
FOLLOWING  LIST,"  followed 
by  a  list  of  acceptable 
values  through  4000 


NUMBER  OF  BINS  MUST  NOT 
EXCEED  200" 


Piece  length  fails  to  Abort 

satisfy  one  of 
following : 

1)  evenly  divisible  by  8 

2)  no  prime  factor 
greater  than  5 

3)  £4000 

Self-explanatory  Abort 


STORAGE  AND  CPU  TIME  REQUIREMENTS; 

As  of  the  date  of  this  report,  program  BIVEC  has  not  been  run 
extensively  on  long  series.  An  operating  history  would  be 
useful  to  the  user  to  enable  him  to  tailor  the  size  of  the 
program.  It  is  intended  to  add  to  the  following  list  as  more 
runs  of  the  program  are  reported. 


TASK 

PIECE 

LENGTH 

NO.  OF 
PIECES 

DIMENSIONS  OF 
W11,W12,W21,W22 

DIMENSIONS 
OF  W31,W32 

DIMENSIONS 
OF  SQ1,SQ2 

PgKR  TORS" 

(PAGE  SIZE 
512) 

TIME 

(MIN) 

CHARGE 

■(CU) 

AUTO  ROTARY 

BICOH. 

SORTING 

256 

39 

2560 

100 

(35,35) 

50 

9.38 

15.85 

AUTO  ROTARY 
BICOH. 

256 

39 

2560 

100 

(35,35) 

50 

9.34 

15.56 

The  sorting  above  was  done  to  determine  confidence  levels 
from  Gaussian  noise.  In  both  cases  the  same  number  of 
rotary  bicoherences  was  calculated.  It  is  anticipated 
that  calculation  of  cross  rotary  bicoherences  for  the  case 
XXY  on  the  above  series  would  take  essentially  the  same 
time,  and  for  the  case  XYY  would  take  approximately  double 
the  time  (and  cost) ,  since  twice  as  many  rotary  bicoherences 
are  calculated. 
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SUBPROGRAMS  REQUIRED;  None 
PROGRAMMER;  Gerard  H.  Martineau 

ORIGINATOR:  Melbourne  G.  Briscoe 


DATE;  October,  1977 


REFERENCES ; 

(1)  Report  on  Program  RBPLOT,  by  G.  H.  Martineau, 

(2)  "Handbook  for  Computer  Users,"  Information  Processing 
Center  of  W.H.O.I.,  pp.  V-E-1  ff. 

(3)  Report  on  Program  FOURIER,  by  G.  H.  Martineau. 

(4)  "Bispectral  and  Cross-Bispectral  Analysis  of  Wind 
and  Currents  off  Oregon  Coast,"  Ph.D.  Thesis  at 
Oregon  State  University,  by  N.  C.  G.  Yao,  June,  1974. 

(5)  "Rotary  Cross-Bispectra  and  Energy  Transfer  Functions 
between  Non-Gaussian  Vector  Processes  I.  Development 
and  Example,"  by  N.-C.  Yao,  Steve  Neshyba,  and  Henry 
Crew,  Journal  of  Physical  Oceanography,  Vol.  5, 
January,  1975 ,  p.  164. 
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Appendix  2 


Permissible  Piece  Lengths  for  Program  BIVEC 


16 

384 

24 

400 

32 

432 

40 

480 

48 

512 

64 

576 

72 

600 

80 

640 

96 

648 

120 

720 

128 

768 

144 

800 

160 

864 

200 

960 

216 

1024 

240 

1080 

256 

1152 

288 

1200 

320 

1280 

360 

1296 

1440 

3456 

1536 

3600 

1600 

3848 

1728 

3888 

1800 

4000 

1920 

1944 

2000 

2048 

2160 

2304 

2400 

2560 

2592 

2880 

2916 

3000 

3072 

3200 

3240 

NAT-IE : 


RBPLOT 


TYPE :  Main  Program 


PURPOSE :  To  construct  auto  or  cross  rotary 

bicoherence  contour  plots  from  disc 
files  produced  by  program  BIVEC(l) 


MACHINE :  Xerox  Sigma-7 


SOURCE  LANGUAGE:  FORTRAN  IV 


DESCRIPTION: 

Program  RBPLOT  reads  consecutive  disc  files  of  auto 
or  cross  rotary  bicoherences  produced  by  program 
BIVEC  and  then  makes  a  contour  plot  of  these  rotary 
bicoherences  over  an  appropriate  domain.  The  pro¬ 
gram  presently  exists  in  two  versions,  RBPLOT05 
which  makes  separately  annotated  plots  (in  separate 
plot  files)  each  over  1/4  of  the  maximum  domain  as 
explained  below,  and  RBPLOT06  which  makes  a  single 
plot  over  the  entire  domain  of  interest. 


INPUT: 

Input  consists  of  two  consecutive  disc  files  in  the 
cases  of  auto  rotary  bicoherence  and  cross  rotary  bi¬ 
coherence  of  form  XXY,  and  four  such  files  in  the  case 
of  cross  rotary  bicoherence  of  form  XYY.  (See  refer¬ 
ence  1  for  explanation  of  notation.) 


OUTPUT : 

(1)  Line  Printer 

Sample  line  printer  output  appears  in  Appendix  1.  A 
facsimile  of  three  input  cards  in  printed,  followed 
by  a  listing  of  the  contour  levels  from  Card  2  under 
a  separate  heading,  "CONTOUR  LEVELS." 

(2)  Plots 

Consider  the  follov/ing  region  in  the 
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In  terms  of  the  notation  of  the  report  on  program 
BIVEC  (ref,  1),  which  calculates  the  rotary  bi¬ 
coherences,  the  user  will  recall  that  auto  rotary 
bicoherences  and  cross  rotary  bicoherences  of 
form  XXY  are  calculated  over  the  domains  1  and  2 
of  figure  1,  while  cross  rotary  bicoherences  of 
form  XYY  require  the  addition  of  3  and  4 .  As 
jngj^^tioned  above,  program  RBPLOT  exists  in  two  ver¬ 
sions,  RBPLOT05  and  RBPLOT06.  RBPLOT05  generates 
separate  plot  files  of  each  region  of  figure  1  as 
appropriate;  thus  it  considers  region  1+2,  or 
1+2+3+4.  The  plots  generated  constitute  Appendix 
2.  They  are  separately  annotated,  but  only  the 
region  1  plot  has  the  data  origin,  contour  levels, 
and  processing  history.  Program  RBPLOT06,  on  the 
other  hand,  generates  a  single  plot  similar  in  ap¬ 
pearance  to  figure  1  and  displayed  as  Appendix  3. 
Again  it  consists  of  regions  1+2,  or  1+2+3+4  as 
appropriate. 

The  program  is  capable  of  producing  disc  plot  files 
to  be  used  for  immediate  or  deferred  Versatec  plots, 
or  a  plot  tape  to  be  used  for  Calcomp  plotting. 

See  the  W.H.O.I.  "Handbook  for  Computer  Users" 
for  details. 


USAGE : 

(1)  Control  cards 

Let  aaa  =  account  number 
uuu  =  user  number 
ffi  =  input  file  names 
ppp  =  plot  file  name 
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Assume  element  file  RBPLOTR  (object  of  RBPLOTS ,  say) 
is  in  account  aaa.  Assume  a  Versatec  plot  is  to  be 
produced  in  this  job.  Then  the  control  card  portion 
of  the  input  deck  is : 

!JOB  aaa,uuu 

ILIMIT  (TIME,t),  (CORE,c) 
lASSIGN  F:l,  (FILE,ffl) 
lASSIGN  F:2,  (FILE,ff2) 

*  lASSIGN  F;3,  (FILE,ff3) 

*  lASSIGN  F:4,  (FILE,ff4) 

**  lASSIGN  F:5,  (FILE , SCRATCH) , (OUTIN) 

ILOAD  (EF  , (RBPLOTR)  ,  (PLOTDFER,  3 )  )  ,  (UNSAT ,  ( 3 )  ) 

IRUN 

IDATA 

- >-  (DATA  CARDS) 

t  1 PLOTV 


(2)  Data  cards 


Program  RBPLOT  has  NAMELIST  input  followed  by  three 
data  cards.  The  NAMELIST  input  must  be  terminated 
by  an  *  card  whether  or  not  any  NAMELIST  variables 
are  being  input. 

The  NAMELIST  parameters  and  their  default  values  are 
as  follows.  In  general,  "switches"  are  set  to  0  for 
"off,"  1  for  "on." 


*Necessary  only  if  plotting  cross  rotary  bicoherences 
of  form  XYY . 

**Necessary  only  for  RBPLOT06,  cross  rotary  bicoherences 
of  form  XYY. 

^Plot  size  is  set  to  Versatec  paper  for  RBPLOT05,  and 
30"  Calcomp  paper  for  RBPLOT06. 
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NAMELIST  Variable 

ISTOREl,ISTORE2 

ISTORE3,ISTORE4 

ISCR 

NDECPL 

>0: 

=  0 

=-l 

<-l 

WIDTH 

CMPPT 

IBUOY 

IFOURIER 


Meaning 

DCB  assignments  for  ] 

input  consecutive 

files 

DCB  assignment  for 
scratch  file 

Format  control  for  axis 
annotation ; 

Number  of  digits  to  the 
right  of  the  decimal 
point  which  are  plotted, 
after  rounding 

Only  integer  portion  of 
number  and  decimal  point 
are  plotted,  after 
rounding 

Only  integer  portion  of 
number  is  plotted, 
after  rounding 

I NDECPL I -1  digits  are 
truncated  from  the  inte¬ 
ger  portion  after 
rounding 

Width,  in  inches,  of  plot  of 
L/2  points  for  RBPLOT05,  L 
points  for  RBPLOT06,  where 
L=piece  length 

Spacing  in  centimeters  be¬ 
tween  adjacent  data  (grid) 
points  on  plot.  If  entered 
by  user,  this  will  override 
any  specification  of  vari¬ 
able  WIDTH 

Switch  to  print  informa¬ 
tion  about  data  origin  on 
plot ^including  original 
buoy  format  file  names  and 
variable  numbers 

Switch  to  print  processing 
history  on  plot  (from  pro¬ 
gram  FOURIER) 


Default  Values 
,2,3,4  in  order 

5 

1 


8.75  for  RBP LOTOS 
24.0  for  RBPLOT06 

WIDTH*2 . 54/ (L/2) 
(L=pc.  length) 

1 

1 
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The  data  cards  follow  the  *card  which  terminates 
NAMELIST  input.  They  are  all  in  generalized, 
free-field  format  and  are  as  follows; 


Card  1 

Variable  No.  Meaning 

1,2,3  This  sequence  of  integers  gives  the 

form  of  auto  or  rotary  cross  bico¬ 
herence;  e.g.,  rotary  cross  of  form 
XYY  is  122,  and  rotary  auto  is  111 
or  222. 


LPIECE  Piece  length 

SAMPSEC  Sample  interval  in  seconds 

FREQTIC  *  Distance  between  tic  marks  on  plot 

in  (hr)~4 


Card  2 


Variable  No. 
1  (NCONLV) 


2 


thru 

(1+NCONLV) 


(2+NCONLV) 

thru 

(1+2 -NCONLV), 


Meaning 

Number  of  contour  levels  to  follow  (£10) 

NCONLV  contour  levels  for  plot 

NCONLV  confidence  levels  (percent) 
for  contour  levels 


Card  3 


-up  to  72  characters  of  identification,  which  will 
appear  immediately  above  the  plot.  The  first  36 
characters  will  appear  on  one  line,  and  the  next 
36  characters  on  the  next  line.  The  user  is  re¬ 
sponsible  for  a  proper  transition  of  text  from  one 
line  to  the  next,  occurring  between  columns  36  and 
37. 


Tf - - 

Full-scale  frequency  (Nyquist  frequency)  is  1800/ 
SAMPSEC.  Variable  FREQTIC  does  not  have  to  divide 
evenly  into  the  full-scale  frequency. 
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RESTRICTIONS ; 

(1)  Program  RBPLOT  uses  a  large  two-dimensional 
buffer,  "DATA,"  which  can  be  thought  of  as  a 
matrix  whose  elements  correspond  one-for-one 
with  the  grid  points  of  the  plot,  and  whose 
rectangular  "boundary"  completely  contains 

the  plot,  the  non-data  points  being  padded  with 
flags  to  that  effect.  The  dimensions  of  DATA 
therefore  govern  the  maximum  piece  length  which 
can  be  plotted.  The  rule  is  as  follows:  If  L 
is  the  piece  length,  then  array  DATA  must  be 
dimensioned  at  least  DATA(R,C)  where: 

C  >  1/2 

R  ^  1. 5C  +  L 

The  "standard"  dimensions  of  DATA  are  DATA ( 200 , 130 ) . 
If  recompilation  is  necessary,  the  following  three 
additional  steps  must  be  taken: 

a)  Array  XDATA(C,R)  is  EQUIVALENCE 'd  to  DATA, 
and  must  have  dimensions  exactly  the  reverse 
of  those  of  DATA. 

b)  Variables  MDl  and  MD2  (immediately  following 
the  above  EQUIVALENCE) ,  must  be  initialized 
to  the  first  and  second  dimensions  of  DATA 
respectively . 

c)  Check  that  array  EXCH  is  DIMENSIONed  the  same 
as  the  first  dimension  of  DATA. 

(2)  The  number  of  contour  levels  must  be  <^10. 


SUBPROGRAMS  REQUIRED:  PLOTDFER,  for  a  Versatec  or  graphics 

terminal  plot. 


STORAGE  REQUIREMENT  AND  TIMING: 

In  a  RBPLOT  run  in  which  PLOTDFER  was  also  loaded,  and 
array  DATA  was  dimensioned  DATA (200 , 130) ,  a  peak  core 
of  77  512-word  pages  was  used,  along  with  1.08  minutes 
of  CPU  time.  This  was  to  plot  auto  rotary  bicoherence. 
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ERRORS  AND  DIAGNOSTICS; 
None 

PROGRAMMER: 

Gerard  H.  Martineau 

ORIGINATOR: 

Melbourne  G.  Briscoe 


DATE: 

October,  1977 

REFERENCES : 


(1)  Report  on  program  BIVEC,  by  Gerard  H.  Martineau 
Woods  Hole  Oceanographic  Institution. 
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10*20  DEC  n2i  *77  ID»0?5B5 
J9B  46?M7l9i7  .  terminal 

LIMIT  (CePE  ,  4  (TI’^P  /  1  )  *  (L9/50  ) »  (DR^  1  ) 

PCL 
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FRE02  tCPH) 


152 


flUTO  ROTARY  BICQHERENCE 


PROCESSING  HISTORY 

NO  LF'S  ll«NO  MOS  ORT«  352"fREM  O-SUOSRHP  O-NSimSRHP  0«PC  SIZE  64 
»NO  PCS  lO-OLRP  l-rSUST  0«HRNN  I  -CftERTED  I4i,ll  HRP  OS.  *78 


CONTOUR  LEVELS  flNQ  PERCENT  CONFIDENCE 

0.4DS  80.0 

TIME  OF  PLOT!  0.436  85.0 

111:56  MflR  08,  '78  0.481  &0 . 0 

0.565  95.0 

0.715  99.0 

3  COUNTER  ROT  VEC'S  S/N=10  HRNNED 
FREQ  8.16,24  NrQUIST=32 


FHEQL  (CPMl 

0  _ 10 _ 15 _ 20 _ 2S _ ^ 


is 

FREQl  (CPH) 


30 


10 


25 
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flUTO  ROTARY  BICOHERENCE 


CONTOUR  LEVELS  AND  PERCENT  CONFIDENCE 


PROCESSING  HISTORY 


0.406  80.000 

0.436  85.000 

0.481  90.000 

0.565  95.000 

0.715  99.000 


3  COUNTER  ROT  VEC’S  S/N=10  HRNNED 
FREQ  8. 16.24  NYQUIST=32 


NO  LF'S  11«N0  HOS  DflTR  352*«PBEW  0« 

SUBSflMP  O-NSueSRMP  0«PC  SIZE  6^**N0  PCS  10 
OLflP  1«<ISUBT  0«HflNN  1  -CREflTEO  14:28  DEC  07,  '77 

TIME  OF  PLOT: 

15:43  OEC  07.  'll 


E.  FORTRAN  IV  LISTINGS,  ALPHABETICALLY 
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-  PROGRAM  BISCAL  - 
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1  - 
2  - 

3  - 

4  - 

5  - 

6  - 

7  - 

8  - 
9  - 

10  - 
11  - 
12  - 

13  - 

14  - 

15  - 

16  - 

17  - 

18  - 

19  - 

20  - 
21  - 
22  - 

23  - 

24  - 

25  - 

26  - 

27  - 

28  - 

29  - 

30  - 

31  - 

32  - 

33  - 

34  - 

35  - 

36  - 

37  - 

38  - 

39  - 

40  - 

41  - 

42  - 

43  - 

44  - 

45  - 
4  6  — 

47  - 

48  - 

49  - 

50  - 

51  - 

52  - 

53  - 

54  - 

55  - 

56  - 

57  - 

58  - 


C  <<<<<<  B  I  S  C  A  L  0  4  >»»> 

C  CALCULATES  BISPECTRA  AMD  CROS  S- BI SP  ECTR  A  FOR  ONE  OR  TWO 
C  REAL  SERIES  AND  DETERMINES  CONFIDENCE  LEVEL S. GENERAT ES  DISC 
C  FILE  FOR  TRANSMITTAL  TO  PLOTTING  PROGRAM. 

C  PROGRAMMER:  G.  MARTINEAU  10/13/77 


DIMENSION  OMl (5400) ,0M2{5400) »SQt70»70) t 
$W3(  300)  ,KBIN{20  0)»ABIN(200)»C0NF(10)fBCL(10)fK.ARD(2U)t 
SLABLI 33) f PHSERR (2) 

EQUIVALENCE  (KBIN,ABIN) 

DOUBLE  PRECISION  Ri ,R2 ♦ R3 tC 1 , C2 t C3 1 SI » S 2 * S 3 1 BR , BC » B MOD, 
$BRP,BCP 

NAMELIST  IOATSTART,MF,ISTORE, 

SBINSIZEfB  ICOHLI  M  »IrlI  ,KBlfKB2»K0NF,LISTBIiI  DUMP  f  I  NORMf 
$  I SQOUT , I HANN, SI GL  VL 
CALL  AB0RTSET(700S,1) 

PI  =  3. 141 59265 ;T WOP  I  =  2.* PI 
IDUMP=1 

MF=21; IDATSTART=5 

IST0RE=1 

IHI  =  1 

M33=0 

BINSIZE=.01;BIC0HLIM=i. 5;KB1=KB2=1;K0NF=0 
SIGLVL  =  -1  ;  PHSERR(2)  =  0. 

K0VER=0  ;  LISTBI=0 

MT0T=0 

IN0RM=0 

ISaOUT=0  ;  IHANN=1 
C  OUTPUT  'ONE'.MTOT 

C 

DO  20  I=l»200 
20  KBINI  I  )  =  0 

C 

ISQD=70 

INPUT 

CALL  DPAR(NERR,MF,l,ltKSUM, 512) 

OUTPUT  I  DAT ST ART , MF , 1ST  OREt  BI NS IZEt 
SBICOHLIM  fIHI,KBl,K8  2tK0NF»L ISTBI,IDUMPt I NORM, I H ANN 
C  CHECK  EXISTENCE  OF  DCS  ASSIGNMENT  FOR  OUTPUT  FILE 
IF  (IDUMP.NE.O)  CALL  GETDCB ( 1ST  ORE, LOCC ) 

READ  (105,1010)  KARD 
1010  FURMAT  (20A4) 

WRITE  (108,1020)  KARD 
1020  FORMAT  ( IH  ,20A4) 

DECODE  (  80,1050 , KARD)  L FW 1 , LF W2  , LFW 1P2 , NP  lECES , 
$LPIECE,NPC1,NPC2,C0NF1,C0NF2 
1050  FORMAT  I 9G) 

IF  (KONF.EQ.O)  GO  TO  23 
READ  (105,1010)  KARO 
WRITE  ( 108, 1020)  KARD 

DECODE  ( 80, 1200 , KARD)  NCONF , NCONF , ( CONF ( I ) , I - 1 , NCON F ) 
1200  FORMAT  (G,NG) 

23  CONTINUE 

IF  (KONF.NE.O)  NBINS= INT ( BI COhL IM/BINSI ZE +0.5 ) ; 
$BICDHLIM=NBINS*8INS IZE  ; 

SWRITE  (108,1600)  BICOHLIM 

1600  FORMAT  ('ADJUSTED  BICOHERENCE  LIMIT,  HOLDING  8INSIZE  ', 
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59  - 

60  - 
61  - 
62  - 

63  - 

64  - 

65  - 

66  - 

67  - 

68  - 

69  - 

70  - 

71  - 

72  - 

73  - 

74  - 

75  - 

76  - 

77  - 

78  - 

79  - 

80  - 
81  - 
82  - 

83  - 

84  - 

85  - 

86  - 

87  - 

88  - 

89  - 

90  - 

91  - 

92  - 

93  - 

94  - 

95  - 

96  - 

97  - 

98  - 

99  - 
100  - 
101  - 
102  - 

103  - 

104  - 

105  - 

106  - 

107  - 

108  -  I 

109  -  I 

110  - 
111  -  ( 
112  - 

113  - 

114  - 

115  - 

116  - 

117  - 

118  -  ( 


$'AS  INPUT  • ,F6.2) 

IF  I (L ISTBI .NE.O) .AND.I INORM.EQ.O))  WRITE  (108fl321) 

1321  FORMAT  (/,T3,  ’FI* ,T9,*F2'  ,T 15 , • F3 • ,T22, • 8 IC • , T30 , * B IPH* , 
$T40, 'BIMOD*  tT52, • BI  SPECR*  #T 65 1 • BI SPECl •  ,T78,»AUT0F1 *  t 
$T90,'AUTOF2ST101  t  *  AUT0FIF2  •  , T1 17,  •  SO'  ,  T 125  » •  PHSERR  • ,  /  ) 
IF  HLiSTBI  .NE.O)  .AND.(  INORM.NE  .0)  )  WRITE  (  108,1431) 

1431  FORMAT  ( /  ,T3, ' F 1 • ,T 9 , • f  2* ,T 1 5 , • F3 • , T 22 , • B IC • , T 30 , • B I PH'  , 
$T4l,'BISPPR* ,T55, ' 8  I SPP I • ,T65 , • PHSERR* ,/) 
NPCS=NPC2-NPC1*-1 

IF  UNPCS.EQ.l)  .ANO.IIHANN.EQ.l  ))  IHANN=0  ;  OUTPUT 
$*IHANN  HAS  BEEN  SET  TO  0,  CAN'*T  OVERLAP  WITH  ONE  PIECE' 
IF  (IHANN.EQ.l)  ED0F=36 .♦NPCS+NPCS/ ( 19*NPCS-1 ) 

IF  (IHANN.EQ.O)  ED0F=2^NPCS 
IF  (SIGLVL.LT.O.)  S IGLVL=SQRT (6 ./ EDOF ) 

LPHALF=LPIECE/2 
IF  (M0D(LPHALF,2) .EQ.l ) 

$STOP  • (PIECE  LENGTH)/2  MUST  BE  EVEN* 

NFHALF=LPHALF/2 
IF  (LISTBI.EQ.O)  GO  TO  25 
25  CONTINUE 

C  DECIDE  WHETHER  TO  CALCULATE  CROSS-BISPECTRA 
NSERIES=2 

IF  ((LFW1.NE.LFW2).  AND.  (LFW1P2.NE  .LFWl)  .AND. 
$(LFW1P2.NE.LFW2))  OUTPUT 

S'CANNOT  HAVE  MORE  THAN  TWO  INPUT  SERIES'  ;  STOP 
IF  (ILFW1,EQ.LFW2 ). AND. {LFW2.EQ.LFW1P2) )  NSERIES=1 
ISQ=1 

C  CHECK  INPUT  INFO.  AGAINST  LABELS 
C  OUTPUT  'MK  1*,IDATSTART 

C 
C 

NFREQLQ=NFHALF«-1 

NFREQHI=NFHALF 

NPTSLO=NPIECES* (2*NFREQL0-1 ) 

NPTSHI=NPIECES*(2*NFREQHI-1 ) 

C 

C 

30  CONTINUE 
C 

C  SET  ARRAY  Sd  TO  -999. 

C 

IF  (IDUMP.EQ.O)  GO  TO  41 
C 

DO  40  I=1,ISQD 
C 

DO  40  J=1,ISQU 

40  SQ( I, J)=-999. 

C 

41  CONTINUE 

OUTPUT  LFWl, IDATSTART,NPTSLO,NPTSHI ,ISd 
IF  (ISO. EQ.l)  CALL  ROISC (LFWl , I DATSTART , OMl , NPTSLO) 

OUTPUT  'MK  3* 

IF  {( ISa.NE.3).0R.{NSER IES.NE.2 I.OR.ILFWl .NE.LF W2) ) 

$G0  TO  46 
00  43  1  =  1, NPTSLO 
43  0M2(I)=0M1(I) 

46  CONTINUE 

IF  ( ISQ. EQ.3) CALL  ROISC ( LFW 1 , ID ATST ART>NPTSLO ,0M1 , N PTSH I ) 
OUTPUT  'MK  4* 
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119 

120 
121 
122 

123 

124 

125 

126 

127 

128 

129 

130 

13  1 

132 

133 

134 

135 
1  36 

137 

138 

139 

140 

141 

142 

14  3 

144 

145 

146 

147 

148 

149 

150 

151 

152 

153 

154 

155 

156 

157 

158 

159 

160 
161 
162 

163 

164 

165 

166 

167 

168 

169 

170 

171 

172 

173 

174 

175 

176 

177 

178 


IF  ((ISa.NE.l).OR.(MSERIES.NE.l))  GOTO  75 
C 
C 

DO  50  I=1,NPTSL0 
50  0M2(I)=0M1( I) 

C 

C 

GO  TO  100 
75  CONTINUE 

IF  INiER  lES.EQ. 1)  GO  TO  100 

IF  ( ( ISa.EQ.l ).AND. ILFW1.NE.LFW2) ) 

$CALL  RDISCILFW2 ,IDATSTART,0M2,NPTSL0) 

IF  ((  I60.E0.1 ) .AND.  ( LFW 1. EQ . LFW 2 ) I 
SCALE  RUISC{LFW1P2 , 1  DAT  START  »0M2,NPTSLC) 

IF  (( IS0.EQ.5).AND. ( LFW 1. NE .LFW 2 ) 1 
SCALE  RDISC(LFW2,IDATSTART+NPTSL0,0M2,NPTSHI ) 
IF  ((  IS0.EQ.5  ).AND.  (LFW  l.EO  .LFW  2)  ) 

SCALE  RDISC(LFW1P2 ,I DATSTART , 0M2 ,NPTSLL ) 

C 

100  CONTINUE 
C 

C  OUTPUT  'MK  7* 

CALL  RASTER 
NCPT=NFIRST 

C  OUTPUT  • MK  8' tNCPT 

105  CONTINUE 
C  OUTPUT  ‘MK  9* 

CALL  FREUINIT 
110  CONTINUE 
C  OUTPUT  'MK  10* 

IF3=  IF  1+ IF  2 
IF2A=IABS(IF2) 

IF3A=IA8S( IF3 ) 

IST3=iOATSTART<-I2*(  I  F3A- 1)4- 1 )  *N  P I  ECES 
NR3=2*NP lECES 

IF  (IF3A.EQ.LPHALF)  NR3=NPIECES 
IF  (IF3A.EQ.0)  NR3=NPIECES 

IF  ( IF3A.GT.LPHALF)  STOP  ‘CHKPT  1;  CHK  LOGIC* 
C  READ  IN  SUM  FREQUENCY  COEFFICIENTS  IF  NECESSARY 
C  OUTPUT  • MK  101* , I SQ 

CALL  SUMFREQ 

C  OUTPUT  'MK  102',IREA0 

IF  (IREAD.EQ.O)  GO  TO  120 

C  DON'T  READ  SUM  FREQ  IF  ALREADY  HAVE  IN  THIS  SCAN 
IF  (Mi3.EQ.l)  GO  TO  160 
C  OUTPUT  'MK  11* 

C  OUTPUT  LFW1P2,IST3,NR3 

CALL  RDI SCI LFH1P2, I ST3, W3,NR3) 

M33=l 
GO  TO  160 

C  117  OUTPUT  'MK  13* 

C 

120  CONTINUE 
C  OUTPUT  'MK  131* 

C 

C  SUM  FREQ  COEFF'S  WILL  COME  FROM  OMl  OR  0M2 
IF  (ISQ.GT.2)  GO  TO  138 
IST3=(2*IF3A-1)  *NPI  £CES«-1 
IF  (NSER  lES.NE.l )  GO  TO  128 
DU  125  I=1,NR3 


160 


179-  125  W3( n=OMl{ IST3+I-1) 

180  -  GO  TO  loO 

181  -  128  CONTINUE 

182  -  IF  (LFWl.EQ.LFW2)  GO  TO  133 

183  -  IF  ((LFW1.NE.LFW2).AND. (LFW1P2.EQ.LFW2) )  GO  TO  133 

I  84  -  DU  130  1=1, NR3 

185  -  130  W3( I )=0M1 ( IST3+I-1) 

186  -  GO  TO  160 

187  -  133  CONTINUE 

188  -  DO  135  1=1, NR3 

189-  135  W3( I )=QM2 ( IST3f I-l) 

190  -  GO  TO  160 

191  -  138  IF  (ISQ.GT.3)  GO  TO  148 

192  -  IST3=2*( IF3A-NFHALF-l)*NPIECESfl 

193  -  IF  (NSER  lES.NE.l)  GO  TO  143 

194  -  DO  140  I =1,NR3 

195  -  140  W3(n=0Ml(IST3  +  I-l) 

196  -  GO  TO  160 

197  -  143  CONTINUE 

198  -  IF  (LFW1P2.EQ.LFW2)  GO  TO  148 

199  -  DO  145  I=1,NR3 

200  -  145  W3I  I)=0M1(IST3«-I-1) 

201  -  GO  TO  160 

202  -  148  CONTINUE 

203  -  IF  {ISQ.EQ.5)  GO  TO  155 

204  -  IF  (LFW1P2.EQ.LFW2)  GO  TO  152 

205  -  IST3=2*(  IF3A-NFHALF-1)*NPIECES*-1 

206  -  DO  150  I=1,NR3 

207  -  150  W3(  I)=0M1{  IST3<-I-1) 

208  -  GO  TO  160 

209  -  152  IST3=( 2*IF3A-1)*NPI ECESfl 

210  -  DO  154  1  =  1, NR3 

211  -  154  W3( I)=UM2(IST3+I-1) 

212  -  GO  TO  160 

213  -  155  CONTINUE 

214  -  IST3=(2-»=IF3A-l)*NPIECESfl 

215  -  IF  (LFWl  .NE.LFW2)  GO  TO  160 

216  -  DO  157  1=1, NR3 

217-  157  W3(  I)=0M2(  IST3«-I-1) 

218  -  GO  TO  160 

219  -  C 

220  -  C 

221  -  160  CONTINUE 

222  -  C  OUTPUT  • MK  16' 

223  -  C 

224  -  ISTl=l  +  (2*(  IF1-1H-1)*NPIECES 

225  -  IF  (ISQ.GT.2)  I  ST 1=2*( I Fl-NFHALF-1 ) ♦NPI EC ES H 

226  -  IST2=l  +  (2<'(  IF2A-1  )H)»NPIECES 

227  -  IF  (ISQ.E0.5)  I  ST2=2«{  I  F2A-NFHALF-1  )*NP  I  ECES  ♦■I 

228-  IF  (IFi.EQ.O)  IST1=1 

229  -  IF  (IF2A.EQ.0)  IST2=1 

230  -  C  CALCULATE  8ISPECTRAL  COEFFICIENTS 

231  -  BR=BC=S1=S2=S3=0. 

232  -  0NE=1. 

233  -  IF  (IF2.lt. 0)  0NE=-1. 

234  -  C 

235  -  C 

236  -  C  OUTPUT  'MK  17 • , IS T 1 , I  ST 2 

237  -  DO  200  I=NPC1,NPC2 

238  -  Rl=aMlI  ISTH-I-1 ) 


239  - 

240  - 

241  - 

242  - 

243  - 

244  - 

245  - 

246  - 

247  - 

248  - 

249  - 

250  - 

251  - 

252  - 

253  - 

254  - 

255  - 

256  - 

257  - 

258  - 

259  - 

260  - 
261  - 
262  - 

263  - 

264  - 

265  - 

266  - 

267  - 

268  - 

269  - 

270  - 

271  - 

272  - 

273  - 

274  - 

275  - 

276  - 

277  - 

278  - 

279  - 

280  - 
281  - 
282  - 

283  - 

284  - 

285  - 

286  - 

287  - 

288  - 

289  - 

290  - 

291  - 

292  - 

293  - 

294  - 

295  - 

296  - 

297  - 

298  - 


I6l 

C1=0M1(  IST14^NPIECES«-I-1  ) 

IF  ((  IFl -EQ.O  ).OR.(  IFl.  EQ.LPHALF)  )  Cl=0. 

IF  ULFW1.EQ.LFW2).AND.  (  NSE  R  I ES  .  EQ.  2)  .  A  NO  . 

$(  ISQ.ME.3).AND.  (  ISQ.NE.4n  GO  TO  180 
R2=0M2I IST2+I-1 ) 

C2=0M2(  IST2*-NPIECES<-I-1  ) 

GO  TO  190 
180  CONTINUE 

R2=0M1(  IST2  +  I-1  )  ;  C2=0M1(  IST2«-NPiECES*-I-l  > 

190  CONTINUE 

IF  ( (  IF2A.EQ.0)  .OR.  (  IF2A.  EQ.LPHALFH  C2=0. 

R3=W3(  I  ) 

C3=W3m-NPIEC£S) 

IF  ((  IF3A. EQ.O). OR.  (IF3A. EQ.LPHALF)  )  C3=C. 

IF  (INORM.EQ.O)  GO  TO  195 

BRP=  R1«R2*R3«-0NE*R1*C2*C3*-C1*R2*C3-0NE*C1*C2*K3 

BCP=  0NE*Rl»C2*R3-  R1^R2«C3  fCl*R2*R3*-0NE^Cl*C2*C3 

BM00=DSQRT{BRP»*2*-3CP**2) 

BR  =  BR«-BRP/BMOD  *,  BC=BC BC P/ 8M0D 
GO  TO  200 
195  CONTINUE 

BR=BR«-  Rl*R2*R3f  0NE*R1*C2»C3+-C1»R2*C3-0NE*C1*C2*R3 

8C=BC+-0NE*R1*C2*R3-  R  1»R  2*C  3f C  1*R2*R  3*-0NE*Cl *C2*C3 

Si=Sl<-Rl«Rl+Cl«Cl 
S2=S2<-R2»R2i-C2*C2 
S3=S3*-R3*R3  4-C3^C3 
200  CONTINUE 
C 

c 

IF  (INORM.EQ.O)  GO  TO  202 
BIC0H=lDSQRT(BR**2f8C**2 ) )/NPCS 
GO  TO  20  4 
202  CONTINUE 

BR=8R/NPCS  ;  BC=6C/NPCS 
S1=S1/NPCS  ;  S2=S2/NPCS  ;  S3=S3/NPCS 
C  OUTPUT  SifS2,S3,NPCS 

SD=DSQRT ( S1*S2*S3) 

C  OUTPUT  BR»BC,SD 

BIC0HR=8R/SD 
8IC0HC=BC/SD 

6IC0H=SQRT(  BIC0HR*8  IC0HR4-BI COHC  *8  ICQHC  ) 

204  CONTINUE 
8IPHSE=DATAN2  IBC.BR  ) 

BIPHSE=B1PHSE*360./TW0PI 

C  OUTPUT  'TWOSMTOT 

IF  (KONF.NE.O)  CALL  C8IN 
C  OUTPUT  BICOH 

BIMOD=DSQRT  (BR*8R<-8C*BC  ) 

IF  (LISTBI.EQ.O)  GO  TO  215 
IF  (INOkM.NE.O)  GO  TO  212 

IF  (( BICOH. LE.CONFi ) .OR. (BICOH. GT.CaNF2 ) )  GO  TO  215 
IF  (IHANN.NE.l)  GO  TO  205 
IF  (BICOH. GE. SIGLVL  )  NPH=1  ; 

$PHSERR(i )=57.296*ASIN(1.96/SQRT IEDOF)/BICOH)  ;  GO  TO  206 
NPH=0  ;  GO  TO  206 

205  CONTINUE 

IF  ((  IHANN. EQ.O).  AND. (BICOH. GE. SIGLVL))  NPH  =  1  ; 

SPHSERRd  )=SQRT12.*NPCS)  ;  GO  TO  206 
NPH=0 

206  CONTINUE 
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30  2 
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304 
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306 

307 

30  8 

309 

310 

311 

312 
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31  9 

32  0 
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328 
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331 
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334 
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336 

337 

338 
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340 

341 
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343 

344 

345 

346 

347 

348 
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350 

351 

352 

353 

354 
35  5 
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WRITE  (  108,2000)  IF  1 , 1 F2 , IF3 ,B I COH, B I PHSE ,BI MOD , BR,  BC, 
$Sl,S2,S3,SD,NPH, (PHSERR( I ), 1=1, NPH) 

2000  FORMAT  ( X , 1 4, 2( 2X , I  4 ) , 3X ,F5 . 3 , 3X, F6. 0 , -X , IH  , 3 ( 2X , E 11 .3 ) , 
$3(iX,Ell.3) ,2X,EII. 3,3X,N(F5.1) ) 

GO  TO  215 

212  CONTINUE 

IF  ((BICOH.LE.CONFl ).0R. (BIC0H.GT.C0NF2) )  GO  TO  215 
IF  (IHANN.NE.l)  GO  TO  213 
IF  (BICOH.GE.SIGLVL )  NPH=1  ; 

SPHS£RR(i)=57.296*ASIN(1.96/SQRT(ED0F)/8IC0H)  ;  GO  TO  214 

NPH=0  ;  GO  TO  214 

213  CONTINUE 

IF  (( IHANN.EQ.O). AND. (BICOH.GE.SIGLVL))  NPH=1  ; 
$PHS£RR(i)=SQRT(2.*NPCS)  ;  GO  TO  214 
NPH=0 

214  CONTINUE 

WRITE  (108,2100)  IFl , IF2 , IF3,BI COH, BIPHSE , 
$BR/NPIECES,BC/NPI EC E S ,NPH , ( PHSERR ( I ) ,I=l,NPh) 

2100  FORMAT  ( X , I  4, 2( 2X , I  4) , 3X,F5 . 3 ,3X, F6.0,-X , IH  , 
$2(3X,E11.3),3X,N(F5.1)  ) 

215  CONTINUE 

C  OUTPUT  IFl 

C  COMMIT  BICOH  TO  STORAGE  BUFFER  SQ 
IF  (IDUMP.EQ.O)  GO  TO  242 
CALL  INDEX 
SQINROW, NCOL)=BICOH 
242  CONTINUE 
C  INCREMENT  FREQUENCIES 

IFi=IFH-l  ;  IF2=IF2-1 
C  END  OF  SCAN? 

CALL  BOUNDARY 
GO  TO  (  110,250)  ,  IBDYH 
C  INCREMENT  SCAN 

250  NCPT=NCPT4-1  ;  M33=0 
C  WRITE  (  108,2222)  IF1,ISQ,NCPT 

C2222  FORMAT  ( IH  , • IF  1= • , I  3 ,2 X, • I SQ= • , I  2 , 2X , • NCPT  =  • , I  3) 

C  END  OF  RASTER 7 

IF  (NCPT.LE.NLAST )  GO  TO  105 
C  OUTPUT  TO  DISC 

IF  (IDUMP.EQ.O)  GO  TO  260 

WRITE  (ISTORE)  ( ( SQ ( I , J ) , 1= 1 , NFHALF) ,U= 1, NFHALF ) 

260  CONTINUE 

C  INCREMENT  INDEX  FOR  AREA  BEING  CONSIDERED  ( ISQ) 

IF  (ISQOUT.NE.O)  OUTPUT  ISQ 
ISQ=ISQH1 

IF  (  (NSER  lES.EQ.l  ).  AND.  (  ISQ.EQ.  2)  )  ISQ=ISQ*-1  ;  GO  TO  30 
IF  ((NSERIES. EQ.l). AND. ( ISQ.EQ. 4))  GO  TO  40C 
IF  (ISQ.LE.5)  GO  TO  30 
C 

400  CONTINUE 

C  TRANSFER  FOURIER  LABELS  TO  BICOHERENCE  FILE  IF  APPROPRIATE 
IF  (IDUMP.EQ.O)  GO  TO  450 
IF  (IDATSTART.NE.5)  GO  TO  420 
CALL  RDISC(LFW1 ,1  ,LABL,4) 

WRITE  (ISTORE)  (L ABL ( I ) , 1=1 ,4 ) 

CALL  R0ISC(LFW2,1 ,LABL,4) 

WRITE  (ISTORE)  (LABL I  I ) , 1=1 , 4 ) 

CALL  R0ISC(LFW1P2,1 ,LABL,4) 

WRITE  (ISTORE)  (LABL( I ) , 1=1 , 4 ) 

WRITE  ( ISTORE)  MF 
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387 

388 

389 

390 

391 
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393 
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395 

396 

397 
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399 
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401 
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GO  TO  440 
420  CONTINUE 

DO  425  1=1,3 
425  LABL( I )=4H 
LABL{4)=0 
DO  430  KZ=1,3 

430  WRITE  (ISTORE)  (L ABL (  1) , I  =  1 , 4  ) 

WRITE  (ISTORE)  MF 
440  CONTINUE 

IF  (MF.NE.21)  GO  TO  450 
CALL  RUISC(21,1,LA8L,33) 

WRITE  (ISTORE)  LABL 
450  CONTINUE 

C  OUTPUT  •  THREE  SMTOT 

IF  (KONF.NE.O)  CALL  CONFIDENCE 

C 

c 

GO  TO  750 

700  STOP  'ASORTSET  TERMINATION* 

750  STOP  'NORMAL  PROGRAM  COMPLETION* 

C 

C 

SUBROUTINE  BOUNDARY 

C  INTERNAL  SUBROUTINE  FOR  PROGRAM  BISCAL03  TO  TEST 
C  SCAN  FOR  FREQUENCY  LIMITS 
IBDY=1 

GO  TO  (100,200,300,400,500) ,ISQ 
100  IF( ( IFl.LE.NFHALF ). AND. I IF2.GT.0) )  I8DY=0 
RETURN 

200  IF  (IFl.LE.NFHALF)  IBDY=0 
RETURN 

300  IF  (IF2.6T.0)  IBDY=0 
RETURN 

400  IF  ((NCPT.LE.NFHALF).AND.(IF2.GE.-NFHALF) )  IB0Y=0 
IF  ((NCPT.GT.NFHALF).AND.(IFl.LE.LPHALF))  IBDY=0 
RETURN 

500  IF  ( IFl.LE.LPHALF )  IBDY=0 
RETURN 
C 
C 

SUBROUTINE  FREQ  INI  T 

C  INTERNAL  SUBROUTINE  FOR  PROGRAM  BISCAL03  TO  INITIALIZE 
C  FREQUENCIES  FOR  A  GIVEN  LINE  OF  SCAN 
GO  TO  ( 100,200,300,400,500) , ISQ 
100  IFl=NCPT/2  ;  IF2=NCPT/2 

IF  (M0D(NCPT,2)  .EQ.l)  IF1  =  IFH-1 
RETURN 

200  IF1=NCPT«-1  ;  IF2=-1 
RETURN 

300  IF1=NFIRST-1  ;  IF2=NCPT-IF1 
RETURN 

400  CONTINUE 

IF  (NCPT  .LE.NFHAL  F)  I  F 1  =NFHALF 1  ; 
tIF2=-lFH-NCPT 

IF  (NCPT.GT.NFHALF)  IF1=NCPT*-1  ;  IF2=-1 
RETURN 

500  IF1=NCPT*-NFHALF<-1  ;  IF2=-NFHALF-1 
RETURN 
C 
C 
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419  - 

420  - 

421  - 

422  - 

423  - 

424  - 

425  - 
42  6  - 
427  - 

42  8  - 

429  - 

430  - 

431  - 

432  - 

433  - 

434  - 

435  - 

43  6  - 
437  - 

43  8  - 

439  - 

440  - 

441  - 

442  - 

443  - 

444  - 

44  5  - 
446  - 
44  7  - 

448  - 

449  - 

450  - 

451  - 

452  - 

453  - 

454  - 

455  - 

456  - 

457  - 

458  - 

459  - 

460  - 

461  - 
46  2  - 

463  - 

464  - 
46  5  - 
466  - 

46  7  ~ 

468  - 

469  - 

470  - 

471  - 

472  - 

47  3  - 

474  - 

475  - 

476  - 

477  - 

478  - 


SUBROUTINE  INDEX 

C  INTERNAL  SUBROUTINE  FOR  PROGRAM  BISCAL03  TO  RELATE 
C  FREQUENCIES  TO  STORAGE  ARRAY  INDICES 
GO  TO  1 100,200t300»400t500) ,I SQ 
100  NR0W=IF2  ;  NCOL=IFl 
RETURN 

200  NR0W=IF2«-NFHALF4-1  ;  NC0L=IF1 
RETURN 

300  NR0W=IF2  *,  NCOL  =  I FI -NFHALF 
RETURN 

400  NR0W=IF2«-NFHALF  +  1  ;  NC0L=1F1-NFHALF 
RETURN 

500  NROW=IF2<-2*NFHALF+l  ;  NCOL=  I F 1-NFHAL F 
RETURN 
C 
C 

SUBROUTINE  RASTER 

C  INTERNAL  SUBROUTINE  FOR  PROGRAM  BISCAL03  TO  SET  UP  SCAN 
C  PARAMETERS 

GO  TO  ( 100,200,300,400,500) , ISQ 
100  NFIRST=2  ;  NLAST=LPHALF 
RETURN 

200  NFIRST=1  ;  NLAST=NFHALF-1 
RETURN 

300  NFIRST=NFHALF«-2  ;  NLAST  =  LPHALF 
RETURN 

400  NFIRSr=l  ;  NLAST=LPHALF-1 
RETURN 

500  NFIRST=1  ;  NLAST=NFHALF-1 
RETURN 
C 
C 

SUBROUTINE  SUMFREQ 

C  INTERNAL  SUBROUTINE  FOR  PROGRAM  BISCAL03  TO  DETERMINE  wHERE 
C  TO  FIND  SUM  FREQUENCY  COEFFICIENTS 

C  RETURNS  IREAD=1  IF  READING  IS  NECESSARY,  0  OTHERWISE 
IREAD=0 

GO  TO  I  100,400,15  0,200,  300)  ,  ISQ 
100  IF  (IF3A.GT. NFHALF)  IREAD=1 
RETURN 

150  CONTINUE 

IF  (NSERIES.EQ.l)  RETURN 
IF  (LFW1.EQ.LFW2)  IREA0=1  ;  RETURN 

IF  I(LFW1.NE.LFW2).AND. (LFW1P2.EQ.LFW2) )  1READ=1  ;  RETURN 
RETURN 

200  CONTINUE 

IF  ((LFWIP2.EQ.LFW1).AND. ( I F3A.LE. NFHALF ) .AND. 
$(LFW1.NE.LFW2 ) )  IREAD=1  ;  RETURN 
IF  ({LFWIP2.EQ.LFW2 ) .AND. ( I F3A.GT .NFHALF) .AND. 
${LFW1.NE.LFW2 ) )  IREAD=1  ;  RETURN 
IF  ((LFW1.EQ.LFW2). AND. INSERIES. EQ. 2) )  IREAD=1  i  RETURN 
RETURN 

300  IF  (LFWl  .NE.LFW2)  IREAD  =  1 
400  CONTINUE 
RETURN 
C 
C 

SUBROUT INE  CB IN 

C  INTERNAL  SUBROUTINE  FOR  PROGRAM  BISCAL03  T3  DETERMINE 
C  CONFIDENCE  LIMITS  FOR  BICOHERENCES 
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479  -  C  HAS  tNTRY  POINTS  CBIN  TO  PLACE  GIVEN  BICOHERENCE  IN 

480  -  C  BIN  AND  CONFIDENCE  TO  INITIATE  CONFIDENCE  LIMIT  CALCULATION 

481  -  C  OUTPUT  'FOUR’tMTOT 

462  -  IF  (BICOH.LE.BICOHL IH)  GO  TO  100 

483  -  K0VER=KaVER4-l 

484  -  WRITE  (108,  1000)  IF  1 , 1 F2  ,  I F 3 , 8 1 COH 

485  -  1000  FORMAT  CBICOH  LIM  EXCEEDED  AT  FREQ  TRIPLET  •,3(I3,X), 

486  -  $'  WITH  VALUE  *,011.5) 

487  -  IF  (IHI.NE.O)  MT0T=MT0T*-1 

488  -  C  OUTPUT  •FIVE',MTOT 

489  -  RETURN 

490  -  C 

491  -  100  CONTINUE 

492  -  NIB=INT( BICOH/BINSI ZE) fl 

493  -  IF  (NIB.GT.N8INS)  GO  TO  250 

494-  KBINI NIB )=KBIN(NI B) H 

495  -  MT0T-MT0T4-1 

496  -  RETURN 

497  -  C 

498  -  250  CONTINUE 

499-  WRITE  (108,1025)  BI COH, I F 1 , I F2, I F 3 

500  -  1025  FORMAT  CBICOH  OF  •,F6.2,'  AT  FREQ  TRIPLE!  •,3(I3,X), 

501  -  S'  MET  NEITHER  BIN  NOR  LIM  CRITERIA*) 

502  -  MTOT  =  MTOT4-1 

503  -  RETURN 

504  -  C 

50  5  -  C****************************************************^**^**’^' 
506  -  ENTRY  CONFIDENCE 

5  07  -  ♦♦*♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦  ♦♦♦♦ 

508  -  C  OPTIONAL  DISPLAY  OF  PARTITIONING  OF  BICOHERENCES 

509  -  IF  (KBl.EQ.O)  GO  TO  320 

510  -  WRITE  (108,1050) 

511  -  1050  FORMAT  (/,T2,*BIN  NU*,T14,*6IN  LI  MI TS ' , T 32 , ' NO  OF  BIC**S* 

512  -  S,/) 

513  -  C 

514  -  C 

515  -  DO  300  I=1,NBINS 

516-  WRITE  (108,1100)  I , ( I -1 ) *6 1  NS  I ZE ,  I  *8 1  NS  I Z E , KB  I N ( I ) 

517-  1100  FORMAT  I T3 , 1  3  ,T  1  3, 2  (  F4.2  ,4X  )  ,  T  34 , 1  5 ) 

518  -  300  CONTINUE 

519  -  C 
52C  -  C 

521  -  320  CONTINUE 

522  -  C  CONVERT  NO  OF  BIC'S  IN  KBIN  TO  TOTAL  FRACTION  AT  INDEX  VALUE 

523  -  KSUBTQT=0  ;  1=0 

524  -  WRITE  (108,1125)  MTOT 

525  -  1125  FORMAT  (/, 'TOTAL  NO  OF  BIC'S  SUBMITTED:  *,15,/) 

526  -  FTOT=FLOAT(MTOT ) 

527  -  C 

528  -  340  CONTINUE 

529  -  I  =  I«-1 

530  -  IF  (I.GT.NBINS)  Gil  TO  350 

531  -  C 

532  -  KSUBT0T=KSUBT0T<-K8IN(I  ) 

533  -  C  OUTPUT  I , KSUB TOT , KB  I N 1 1  ) , FTOT 

534-  AB1N( I )=FLOAT (KSUBTOT ) 

535-  A81N( I )=ABIN( I)/FTOT 

536  -  C  OUTPUT  A6IN( I  ) 

537  -  GO  TO  340 

538  -  C 
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539  - 

540  - 

541  - 

542  - 

543  - 

544  - 

545  - 
54  6  — 

547  - 

548  - 

549  - 

550  - 

551  - 

552  - 

553  - 

554  - 

555  - 

556  - 

557  - 

558  - 

559  - 

560  - 

561  - 

562  - 

563  - 

564  - 

565  - 

566  - 

567  - 

568  - 

569  - 

570  - 

571  - 

572  - 

573  - 

574  - 

575  - 

576  - 

577  - 

578  - 

579  - 

580  - 

581  - 

582  - 

583  - 

584  - 

585  - 

586  - 

587  - 

588  - 

589  - 

590  - 

591  - 

592  - 

593  - 

594  - 


350  CONTINUE 

C  OPTIONAL  DISPLAY  OF  PARTIAL  SUHS  AT  INDEX  VALUE 
IF  (KB2.EQ.0)  GO  TO  400 
WRITE  (108, 1150) 

1150  FORMAT  1/ ,T32 , * FRACT  BELOW* ,/ ,T 2, • BIN  N0*,T14, 

S*BIN  LIMITS* ,T3l, 'UPPER  BIN  LIM*,/) 

C 

C 

DO  380  I=1,NBINS 

write  (108,1200)  I, (I-1)*BINSIZE,I^BINS12E,ABIN{I ) 

1200  FORMAT  ( T 3 , 13 ,T 13 ,2 ( F4. 2 ,4X ) , T34, F5 . 3 ) 

380  CONTINUE 
C 
C 

400  CONTINUE 
C 
C 

C  COMPUTE  CONFIDENCE  LIMITS 
1=0 
C 

420  CONTINUE 
I  =  I*l 

IF  (I.GT.NCONF)  GO  TO  600 
J=0 
C 

450  CONTINUE 
J=J  +  1 

IF  (J.GT.NBINS)  WRITE  (108,1250)  CONF(l)  ;  BCL(I)=999. 
$G0  TO  420 

1250  FORMAT  ('BINS  EXHAUSTED  FOR  CONFIDENCE  LEVEL', F6. 3) 

IF  1ABIN( J).GE.CONF ( I ))  GO  TO  470 
GO  TO  450 
C 

470  CONTINUE 
C 

JH=J 

JL=J-1 

Y1=JL*BINSIZE 

Y2=JH»8INSIZE 

X1=0 

IF  (JL.NE.O)  X1=ABINIJL) 

X2=ABINIJH) 

XO=CONF( I ) 

BCLII )=Y1*(X0-X1) ♦(Y2-YI)/{X2-X1) 

GO  TO  420 
600  CONTINUE 
C 

C  PRINT  CONFIDENCE  LEVELS 

WRITE  (108,1400)  NCONF ,  I CONF  (  I )  *100  .  ,  BC  L  (  I )  ,  1  =  1 ,  NCONF  ) 
1400  FORMAT  ( / ,T4, * CONFI DENCE » ,/ , T6,  * LEV  EL • , T2 1 , ' BI C OHERENCE 
$/,T5, * (PERCENT) • ,/,N(T7 ,F4. 1,T24,F5.3,/),/) 

WRITE  (108,1450)  BI COHL IM,KOVER 
1450  FORMAT  ('NO.  OF  BICOHERENCES  GREATER  THAN  SPECIFIED  ', 
S'MAXIMUM  OF  ',F5.2,'  IS  *,I5,/) 

RETURN 

END 


f 
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PROGRAM  BISUM 
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1  - 

2  - 

3  - 

4  - 

5  ~ 

6  - 

7  - 

8  - 
q  - 

10  - 
11  - 
12  - 

13  - 

14  - 

15  - 

16  - 

17  - 

18  - 

19  - 

20  - 
21  - 
22  - 

23  - 

24  - 

25  - 

26  - 

27  - 

28  - 

29  - 

30  - 

31  - 

32  - 

33  - 

34  - 

35  - 

36  - 

37  - 

38  - 

39  - 

40  - 

41  - 

42  - 

43  - 

44  - 

45  - 

46  - 

47  - 

48  - 

49  - 

50  - 

51  - 

52  - 

53  - 

54  - 

55  - 

56  - 

57  - 

58  - 


C  «««<  B  I  S  U  M  0  2  »»»> 

C  CALCULATES  BISPECTRA  AND  CROSS-BISPECTRA  FOR  ONE  OK  TWO 
C  REAL  SERIES  AND  INTEGRATES  THEM  OVER  CONSTANT  SUM  FREQUENCIES 
C  AND  PRINTS  FORMATTED  SUMMARY 

C  PROGRAMMER:  GERARD  H.  MARTINEAU  1/19/78 

C  ORIGINATOR:  MELBOURNE  G.  BRISCOE 

DIMENSION  OMl (5400) , 0M2 ( 5400 ) ,S Q ( 70 , 70) , 

$W3( 300) ,CONF( 10),8CL(10) ,KARD(20) , 

$LABL(33) ,PHSERR(2) 

DIMENSION  BRU(130)#8IU(130) , BIC U( 130) ,B IC2U { 130 ) ♦ 
$BCSU(130),BRL(130),6IL(130)  ,  B IC  L  ( 130  )  ,B  IC  2L  ( 1 30  )  , 
$BCSL(130) 

DOUBLE  PRECISION  R1 , R2, R3,C 1, C2 ,C 3, SI ,S2 , S3 , 8R , BC,BMOO, 
$BRP,BCP,BM 

NAMELIST  IDATSTART.MF.ISTORE, 

$BINSIZE»flICOHLIM, IHI ,KB1 ♦ KB2f L I STBI » IDJMP  1 1  NORM, 

$  I SQOUT ,  I  HANN, SI GLVL ,KOCB ,KD I  SC 
CALL  ABORTSET (700S, 1 ) 

PI=3.141  59265  awOPI^Z.^PI 
IDUMP=0 

KDC8=2  ;  KDISC=0 

MF=21; IDATSTART=5 

IST0RE=0 

JD1M=130 

IHI  =  1 

M33=0 

BINSIZE=.01;BIC0HLIM=1.5;KBl=KB2=i;K0NF=0 
SIGLVL=-1  ;  PHSERR(2)=0. 

KOVER=0  ;  LISTBI=0 

MT0T=0 

IN0RM=0 

ISQ0UT=0  ;  IHANN=1 
C  OUTPUT  'ONE'.MTOT 

C 
C 

C  INITIALIZE  OUTPUT  ARRAYS 
DO  10  I=1,JDIM 

8RU(I)=BIU(  I)=BIC2U(  I  )  =  8  I CU  (  I  )  =  BC5U  (  I  )  =  0. 
BRL{I)=BIL(I)=BIC2L (I)=BICL{I)=8CSL( I)=0. 

10  CONTINUE 
C 
C 

ISQD=70 

INPUT 

CALL  DPAR{NERR,MF  ,1 , 1,KSUM,  512) 

OUTPUT  i DATSTART, MF , 1ST  ORE, 8 1  NS IZE, 

$BICOHLIM,IHI ,KB1,KB2,LISTBI , I DU MP , I  NORM , I HANN, 

$KDISC,KDCB 

C  CHECK  EXISTENCE  OF  DCB  ASSIGNMENT  FOR  OUTPUT  FILE 
IF  (IDUMP.NE.O)  CALL  GETDCB ( ISTORE, LOCC ) 

READ  (105,1010)  KARD 
1010  FORMAT  (20A4) 

WRITE  (108,1020)  KARD 
1020  FORMAT  ( IH  ,20A4) 

DECODE  ( 80, 1050, KARD)  LFW1,LFW2,LFW1P2,NPIECES, 
$LPIEC£,NPC1,NPC2,C0NF1,C0NF2 
1050  FORMAT  (9G) 

23  CONTINUE 
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59  - 

60  - 
61  - 
62  - 

63  - 

64  - 

65  - 

66  - 

67  - 

68  - 

69  - 

70  - 

71  - 

72  - 

73  - 

74  - 

75  - 

76  - 

77  - 

78  - 

79  - 

80  - 
81  - 
82  - 

83  - 

84  - 

85  - 

86  - 

87  - 

88  - 

89  - 

90  - 

91  - 

92  - 

93  - 

94  - 

95  - 

96  - 

97  - 

98  - 

99  - 
100  - 
101  - 
102  - 

103  - 

104  - 

105  - 

106  - 

107  - 

108  - 

109  - 

110  - 
111  - 
112  - 

113  - 

114  - 

115  - 

116  - 

117  - 

118  - 


IF  ULISTBI  .NE.O)  .AND.(  INORM.EQ.O))  WRITE  (108»i321) 

1321  FORMAT  (  /  ,T3 ,  •  F  1  *  t  T  9  ,  •  F 2  '  ,T  15  t '  F3  •  ,T22,  *6  IC  ,T30,*6  IPH*  , 
$T40,'BIMOO' ,T52,* 81 SPECR* ,T 65 , *  31  SPEC  I '  , T 78 » • AUTOF 1 ' , 
$T90,'AUT0F2» ,T10l ,* AUTUF1F2* ,T117,'SD' ,T125,*PHSEKR' ./) 

IF  KLISTBI.NE.Ol  .AND.I  INGRM.NE.O))  WRITE  (108,1431  ) 

1431  FORMAT  ( / ,T 3,  'F  I*  ,T 9 , 'F 2 '  ,T 15 , ' F3 •  ,  T22,  ' B I C *  , 13 0 , • B I  PH*  , 
$T41,'BiSPPR‘,T55, 'BISPPI • ,T65 , • PHSERR • , / ) 

NPCS=NPC2-NPCH-1 

IF  KNPCS.EQ.l)  .ANO.IIHANN.EQ.D)  IHANN^O  ;  OUTPUT 
S'lhANM  HAS  BEEN  SET  TO  0.  CAN*'T  OVERLAP  WITH  ONE  PIECE* 
IF  IlHANN.EQ.l)  EU0F=36 .♦NPCS*NPCS/ ( 19+NPCS-l ) 

IF  (IHANN.EQ.O)  E0C3F=2*NPCS 
IF  (SIGLVL.LT.O.)  S I GLVL=SQRT (6 ./ EDOF ) 

LPHALF=LPIECE/2 
IF  (MODI LPHALF,2) .EQ.l) 

$STOP  '(PIECE  LENGTH)/2  MUST  BE  EVEN* 

NFHALF=LPHALF/2 
IF  (L ISTBI.EQ.O )  GO  TO  25 
25  CONTINUE 

C  DECIDE  WHETHER  TO  CALCULATE  CROSS-B I  SPECTRA 
NSERIES=2 

IF  ( { LFW1.NE.LFW2 ). AND. I LFW 1P2 . NE .L FW 1 ) .AND. 
i(LFWlP2.NE.LFW2 ) J  OUTPUT 

S'CANNOT  HAVE  MORE  THAN  TWO  INPUT  SERIES*  ;  STOP 
IF  ({LFWi.EQ.LFW2).AND.  (LPW2.EQ.LFW1P2)  )  NSERIES=L 
ISQ=1 

C  CHECK  INPUT  INFO.  AGAINST  LABELS 
C  OUTPUT  'MK  1*,IDATSTART 

C 
C 

NFREQL0=NFHALF+1 

NFREQHI=NFHALF 

NPTSL0=NPIECES*I2<'NFREQL0-1  ) 

NPTSHI=NPIECES* (2*NFREQHI-1 ) 

C 

C 

30  CONTINUE 

C 

C  SET  ARRAV  SO  TO  -999. 

C 

IF  (IDUMP.EQ.O)  GO  TO  41 

C 

DO  40  I=1,ISQD 
C 

DO  40  J=1,ISQD 

40  SQ( I, J)=-999. 

C 

41  CONTINUE 
C 

C  OUTPUT  LFW1,IDATSTART,NPTSL0,NPTSHI ,ISQ 

IF  (ISU.EQ.l)  CALL  RDIS C ( LFW 1 , I DATST ART ,OMl ,NPT SLO ) 

C  OUTPUT  'MK  3* 

IF  (I  ISQ.NE.3).0R.(NSER IES.NE.2).0R. (LFW1.NE.LFW2) ) 

$G0  TO  46 
DO  43  I=1,NPTSL0 
43  0M2{I )=0M1(I) 

46  CONTINUE 

IF  (ISQ.£Q.3)CALL  R  01  SC  (  LFW  1 ,  ID  ATST  ART*-NP  TS  LO  ,D  Ml  ,  N  PT  SH  I  ) 
C  OUTPUT  *MK  4* 

IF  ((  ISU.NE.l  ).OR.(NSERI  ES.NE.l  )>  GO  TO  75 
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119  - 

120  - 
121  - 
122  - 

123  - 

124  - 

125  - 

126  - 
127  - 
12  8  - 

129  - 

130  - 
13  1  - 

132  - 

133  - 

134  - 

135  - 

136  - 

137  - 
138- 

139  - 

140  - 

141  - 

142  - 

143  - 

144  - 

145  - 

146  - 

147  - 

148  - 

149  - 

150  - 

151  - 

152  - 

153  - 

154  - 

155  - 

156  - 

157  - 

158  - 

159  - 

160  - 
161  - 
162  - 

163  - 

164  - 

165  - 

166  - 

167  - 

168  - 

169  - 

170  - 

171  - 

172  - 

173  - 

174  - 

175  - 

176  - 

177  - 

178  - 


C 

C 

DO  50  l=l,NPTSLO 
50  QM2iI  )  =0M1(  I ) 

C 

c 

GO  TO  100 
75  CONTINUE 

IF  INSEft  lES.EQ.l)  GO  TO  100 

IF  ((  ISQ.EQ.D.AND.  (LFW  l.NE  .LFW2)  ) 

SCALE  RDISCILFW2, IDATSTART,0M2,NPTSL0) 

IF  ((  ISQ.EQ.D.AND.  (LFWl  .EQ.LFW2)  ) 

SCALE  RDISC(LFW1P2 ,I DATSTART ,0M2 ,NPTSLO) 

IF  (( ISO. EQ. 5). AND. (LFW l.NE. LFW 2) ) 

SCALE  RDISC(LFW2,IDATSTART+NPTSLa,0M2,NPTSHI ) 
IF  (( IS0.EQ.5I.AND. (LFW1.EQ.LFW2) I 
SCALE  RDISC(LFW1P2 »I DATSTART tOM2 ,NPTSLQ» 

C 

100  CONTINUE 
C 

C  OUTPUT  'MK  7» 

CALL  RASTER 
NC PT=NFIRST 

C  OUTPUT  ' MK  8* ,NCPT 

105  CONTINUE 
C  OUTPUT  • MK  9* 

CALL  FREQINIT 
110  CONTINUE 
C  OUTPUT  *MK  10' 

IF3=  IF1+IF2 
IF2A=IAaS(IF2) 

IF3A=IAaS(IF3) 

IST3=IDATSTART+(2*( I F3A-1 ) +1 ) ♦NPI ECES 
NR3=2*NPIECES 

IF  (IF3A.EQ.LPHALFI  NR3=NPIECES 
IF  (IF3A.EQ-0)  NR3=NPIECES 

IF  (IF3A.GT.LPHALFJ  STOP  'CHKPT  1;  CHK  LOGIC 
C  READ  IN  SUM  FREQUENCY  COEFFICIENTS  IF  NECESSARY 
C  OUTPUT  'MK  lOl'flSQ 

CALL  SUMFREQ 

C  OUTPUT  'MK  102' f I  RE  AD 

IF  (IREAD.EQ.OI  GO  TO  120 

C  DON'T  READ  SUM  FREQ  IF  ALREADY  HAVE  IN  THIS  SCAN 
IF  (M33.EQ.1)  GO  TO  160 
C  OUTPUT  'MK  11* 

C  OUTPUT  LFW1P2,IST3,NR3 

CALL  R0ISC(LFW1P2,IST3,W3,NR3) 

M33=l 
GO  TO  160 

C  117  OUTPUT  'MK  13* 

C 

120  CONTINUE 
C  OUTPUT  'MK  131' 

C 

C  SUM  FREQ  COEFF'S  WILL  COME  FROM  OMl  OR  0M2 
IF  (ISQ.GT.2)  GO  TO  138 
IST3=(2*IF3A-1)*NPI  ECES«-1 
IF  (NSER  lES.NE. 1)  GO  TO  128 
DO  125  1=1, NR3 
125  W3( l)=0Ml(IST3*I-l) 
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179  -  GU  TO  160 

180  -  128  CONTINUE 

181  -  IF  (LFW1.EQ.LFW2)  GO  TO  133 

182  -  IF  HLFW1.NE.LFW2).AND.  (LFW1P2.EQ.LFW2)  )  GO  TO  133 

183  -  DO  130  1  =  1, NR3 

184  -  130  W3( I)=0M1( IST3+I-1) 

185  -  GO  TO  160 

186  -  133  CONTINUE 

187  -  DO  135  I  =1,NR3 

188  -  135  W3( I )=0M2( IST3+I-1) 

] 89  -  GO  TO  160 

190  -  138  IF  (ISQ.GT.3)  GO  TO  148 

191  -  IST3=2*(  IF3A-NFHALF-l)=<'NPIECES«-l 

192  -  IF  (NSER  lES.NE.l)  GO  TO  143 

193  -  DO  140  I =1,NR3 

194  -  140  W3( I)=UH1 ( IST3+I-1) 

195  -  GU  TO  160 

196  -  143  CONTINUE 

197  -  IF  (LFW1P2.EQ.LFW2)  GO  TO  148 

198  -  DO  145  1=1, NR3 

199  -  145  W3( I)=0M1 { IST3FI-1) 

200  -  GO  TO  160 

201  -  148  CONTINUE 

202  -  IF  (ISQ.EQ.5)  GO  TO  155 

203  -  IF  (LFW1P2.EQ.LFW2)  GO  TO  152 

204  -  IST3  =  2*(  IF3A-NFHALF-1)<'NPIECES*-1 

205  -  DO  150  1=1, NR3 

206  -  150  W3( I)=aMl( IST3+I-1) 

207  -  GO  TO  160 

208  -  152  IST3=(2*IF3A-1)*NPIECES«-1 

209  -  DO  154  1=1, NR3 

210  -  154  W3( 1)=GM2(IST3+I-1) 

211  -  GO  TO  160 

212  -  155  CONTINUE 

213  -  IST3={2<'IF3A-l)*NPIECESi-l 

214  -  IF  (LFWl .NE.LFW2)  GO  TO  160 

215  -  DO  157  1=1, NR3 

216  -  157  W3(I)=0N2(IST3+I-1) 

217  -  GO  TO  160 

218  -  C 

219  -  C 

220  -  160  CONTINUE 

221  -  C  OUTPUT  *MK  16* 

222  -  C 

223  -  ISTl=l*-(2*(  IF1-1)«-1)*NPIECES 

224  -  IF  (ISQ.GT.2)  I  ST  1  =  2*(  I  Fl-NFHALF-1 )  ♦NPI  ECES  <-1 

225  -  IST2=H-(  2=«‘(  IF2A-1  )«■  D^NPIECES 

226  -  IF  (ISQ.EQ.5)  I  ST 2=2»( I F2A-NFHALF-1 ) »NP I ECES* 1 

227  -  IF  (IFl.EO.O)  IST1=1 

228  -  IF  (IF2A.EQ.0)  ISr2=l 

229  -  C  CALCULATE  BISPECTRAL  COEFFICIENTS 

230  -  BR=BC=S1=S2=S3=0. 

231  -  0NE=1. 

232  -  IF  (IF2.lt. 0)  0NE=-1. 

233  -  C 

234  -  C 

235  -  C  OUTPUT  'MK  17 ' , I S T1 , I ST2 

236  -  DO  20U  I=NPC1,NPC2 

237  -  Rl  =  aMl( ISTl  +  I-1  ) 

238  -  C1=QM1(  ISTH-NPIECESH-1  ) 
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239  - 

240  - 

241  - 

242  - 

243  - 

244  - 

245  - 

246  - 

247  - 

248  - 

249  - 

250  - 

251  - 

252  - 

253  - 

254  - 

255  - 

256  - 

257  - 

258  - 

259  - 

260  - 
261  - 
262  - 

263  - 

264  - 

265  - 

266  - 

267  - 

268  - 

269  - 

270  - 
2  71  - 

272  - 

273  - 

274  - 

275  - 

276  - 

277  - 

278  - 

279  - 

280  - 
281  - 
282  - 

283  - 

284  - 

285  - 

286  - 

287  - 

288  - 

289  - 

290  - 

291  - 

292  - 

293  - 

294  - 

295  - 

296  - 

297  - 

298  - 


IF 

((  IFl.EQ.O). 

OR. I 

IFl. 

EQ. 

LPHAL 

F))  C1=0. 

IF 

((LFWl.EQ.LF 

M2  ). 

AND. 

(NSERIES 

.EQ.2) .AND. 

$( ISQ.NE.3).AND. 

(  ISQ 

.NE. 

4)) 

GO  T 

0  180 

R2= 

0M2(  IST2<-I-1 

) 

C2= 

0M2( I STZfNPI 

ECES 

«-I-l 

) 

GO 

TO  190 

180  CONTINUE 

R2  = 

OMl  (  IST2<-I-1 

)  ; 

C2=li 

Ml( 

I  ST2^ 

NPIECES*-!-!) 

190  CONTINUE 

IF  (( IF2A.EQ.0J .OR. (IF2A.EQ.LPHALF) )  C2=0. 

R3=W3( I i 

C3=W3{  I«-NPIECES) 

IF  ( I  IF3A.EQ-0)  .OR.  I  IF3A.£Q.LPHALFn  C3=0. 

IF  (INORM.EQ.O)  GO  TO  195 

BRP=  Rl*R2*R3*-ONE*Rl<‘C2*C3fCl*R2*C3-ONE*Cl*C2=!=R3 

BCP=  0NE*R1*C2*R3-  R  1*R2*C3  i-C  1*R2*R3 «-ON E*C1  *02*0  3 

BM0D=DSURT(  BRP«*2<-BCP«*2) 

BR=BR«-8RP/BM0D  ;  8C  =  BC4-BCP/ BMOD 
GO  TO  200 
195  CONTINUE 

aR  =  BR4-  Rl*R2*R34-ONE*Rl*C2*C3i-Ci*R2*C3-OIME*Cl<'C2*R3 

BC=BC*-0N£*R1*C2«R3-  Rl*R2*C3*Cl*R2*R  3<-0NE*Cl*C2«'C3 
S1=SI*-R1*RH-CI<'C1 
S2=S2fR2*R2<-C2*C2 
S3=S3*-R3*R3<-C3*C3 
200  CONTINUE 
C 
C 

IF  IINORM.NE.O)  GO  TO  204 
202  CONTINUE 

BR=BR/NPCS  ;  BC=BC/NPCS 
Sl=Sl/NPCS  ;  S2=S2/NPCS  ;  S3=S3/NPCS 
C  OUTPUT  S1,S2,S3,NPCS 

SD=OSQRTI S1*S2*S3) 

C  OUTPUT  BR,BC,SD 

BIC0HR=8R/SD 
BIC0HC=8C/SD 

204  CONTINUE 
BIPHSe=DATAN2 (BC, BR ) 

BIPHS£=8IPHSE*360./TW0PI 
IF  (INORM.EQ.O)  GO  TO  206 
BIMOD=DSQRT  ( BR*»2  ^-8C*«=2  ) 

BICOH=BIMOD/NPCS 

IF  (IF2.lt. 0)  GO  TO  205 
BRU(IF3A )=BRUI IF3A)+8R/NPCS 
BIU(IF3A)=8IU(IF3A)  «-BC/NPCS 
BICU( IF3A)=BICU(IF3A)+BIC0H 
BIC2U(  IF3A)=8IC2U(  IF3A)*-BIC0H**2 
BCSU(  IF3A  )  =  0. 

GO  TO  208 

205  CONTINUE 

BRL  (  IF3A  )  =BRL  ( I  F3A  )  «-BR/NPCS 
8IL(IF3A  )=8IL(IF3A)4-BC/NPCS 
BICL( IF3A)=BICL(IF3A)+8IC0H 
8IC2L( IF3A)=B IC2L ( I F3A)+BIC0H** 2 
BCSLnF3A»=0. 

GO  TO  208 

206  CONTINUE 

8CM=BIC0FR*BIC0HR  fB ICOHC*BICOHC 
BICOH=SaRT(BCM) 
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29S  - 
3  00  - 

301  - 

302  - 

303  - 
30A  - 

305  - 

306  - 
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333  - 
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337  - 

338  - 

339  - 

340  - 

341  - 

342  - 

343  - 

344  - 

345  - 

346  - 

347  - 

348  - 

349  - 

350  - 

351  - 

352  - 

353  - 

354  - 

355  - 

356  - 

357  - 

358  - 


C  QUTPUr  'TWO'.MTOT 

C  OUTPUT  6IC0H 

BM=8R*BR*-0C+BC 
BIMQD=DSGRT (BM) 

IF  IIF2.LT.0)  GO  TO  207 
BKU(IF3A)=BRU( IF3A»tBR 
BIU(  IF3AJ=BIU{  IF3A»  *-BC 
BICU(  IF3A)  =  BICUI  IF3A)<-8IC0H 
BIC2U(  IF3A)=BIC2U  ( I  F3AUBCM 
BCSUt  IF3A)  =  BCSU(  IF3A)<-BCM*S3 
GO  TO  208 

207  CONTINUE 

BRL ( IF3AI=BRL ( IF3A) ♦BR 
BIL( IF3A )=BIL (IF3A)+BC 
BICLI  IF3A  I  =  BICL  (  I  F3A  KB  ICOH 
BIC2L(  IF3A)=aiC2L  (  IF3A)  ♦•BCM 
BCSLI  IF3A)  =  BCSL  (IF3AK-BCM*S3 

208  CONTINUE 

IF  (L ISTBI.EQ.O )  GO  TO  215 
IF  (INORM.NE.O)  GO  TO  212 

IF  ((  aiCOH.LE.CONFl ).0R. IBIC0H.GT.C0NF2) )  GO  TO  215 
IF  (IHANN.NE.l)  GO  TO  210 
IF  (BICOH.GE.SIGLVL  )  NPH=1  ; 

$PHSERR(1)=57.296«ASIN(1.96/SQRT(ED0F)/8IC0H)  ;  GO  TO  211 
NPH=0  ;  GO  TO  211 

210  CONTINUE 

IF  ((  IHANN.EQ.O  I  .  AND.  (BICOH.GE.SIGLVL) )  NPH  =  1  *, 

SPHSERRI 1 )=SQRT( 2.*NPCS)  ;  GO  TO  211 
NPH=0 

211  CONTINUE 

WRITE  (108,2000  )  IF  1  ,  I F2 , 1  F  3  ,  B I  COH,  B  I  PHSE  ,  B I  MOD ,  BR,  BC  , 
$SL,S2,S3,SD,NPH,(PHSERR(I ) , I=1,NPH) 

2000  FORMAT  ( X , I  4, 2 1 2X , I  4 ) , 3X , F 5 . 3 , 3 X , F6. 0 X , IH  , 3{ 2X , E 1 1 . 3 ) , 
$3{1X,E11.3) ,2X,E 11.3, 3X,N(F 5.1) ) 

GO  TO  215 

212  CONTINUE 

IF  ((BICOH.LE.CONFl  ).0R.(BIC0H.GT.C0NF2))  GO  TO  215 
IF  (IHANN.NE.l)  GO  TO  213 
IF  (BICOH.GE.SIGLVL)  NPH  =  1  ; 

tPHSERRi 1 )=57. 296*AS INI I .96/SQRT (EDOFI/B ICOH)  ;  GO  TO  214 
NPH=0  ;  GO  TO  214 

213  CONTINUE 

IF  ((  IHANN.EQ.O) .AND. (BICOH.GE.SIGLVL))  NPH=1  ; 
$PHSERR{1)=SQRT(2.*NPCS)  ;  GO  TO  214 
NPH=0 

214  CONTINUE 

WRITE  (108,2100)  IF  1 , I F2 , I F3 , BI COH, B I PHSE , 
$BR/NPIECES,BC/NPIECES,NPH,(PHSERR(I ) ,I=1,NPH) 

2100  FORMAT  ( X , I  4, 2 ( 2X , I  4 ) , 3X , F5 . 3 , 3 X, F6. 0 , -X , IN  , 

$2(3X,Eli.3) ,3X,N(F5.1) ) 

215  CONTINUE 

C  OUTPUT  IFl 

C  COMMIT  8IC0H  TO  STORAGE  BUFFER  SQ 
IF  (IQUMP.EQ.O)  GO  TO  242 
CALL  INDEX 
SQ1NR0W,NC0L)=BIC0H 
242  CONTINUE 
C  INCREMENT  FREQUENCIES 

IF1=IF1H  ;  IF2=IF2-1 
C  END  OF  SCAN? 


174 


359  -  CALL  BOUNDARY 

360  -  GO  TO  (110,250),IBDY*1 

361  -  C  INCREMENT  SCAN 

362  -  250  NCPT=NCPT<-1  ;  M33=0 

363  -  C  WRITE  (108,2222)  IF1,ISQ,NCPT 

364  -  C2222  FORMAT  I IH  , » I F 1= » , I  3, 2 X, • I SQ=* , 1 2 , 2X , • NC PT  =  • , 1 3 ) 

365  -  C  END  OF  RASTER? 

366  -  IF  (NCPT.LE.NLAST)  GO  TO  105 

367  -  C  OUTPUT  TO  DISC 

368  -  IF  (lUUMP.EQ.O)  GO  TO  260 

369-  WRITE  (ISTORE)  ( ( SQ ( I , J ) , 1= 1 , NFHALF ) , J= 1 , NFHALF ) 

370  -  260  CONTINUE 

371  -  C  INCREMENT  INDEX  FOR  AREA  BEING  CONSIDERED  (ISQ) 

372  -  IF  I ISQOUT.NE.O)  OUTPUT  ISQ 

373  -  ISQ=ISQF1 

374  -  IF  IINSERIES.EQ.I  ).ANO.(  ISQ.EQ.  2)  )  ISQ=ISQ«-1  ;  GO  TO  30 

375  -  IF  UNSERIES.EQ.l  ).  AND.  {  ISQ.EQ. 4)  )  GO  TO  400 

376  -  IF  (ISQ.LE.5)  GO  TO  30 

377  -  C 

378  -  400  CONTINUE 

379  -  C  TRANSFER  FOURIER  LABELS  TO  BICOHERENCE  FILE  IF  APPROPRIATE 

380  -  IF  IIDUMP.EQ.O)  GO  TO  450 

381  -  IF  (IDATSTART.NE.5)  GO  TO  420 

382  -  CALL  RDISCI LFWl ,1 ,LABL,4) 

383-  WRITE  (ISTORE)  (L ABL ( I ) , 1=1 ,4 ) 

384  -  CALL  RDISC(LFW2,1  ,LABL, 4) 

385-  WRITE  (ISTORE)  (LA3L ( I ) , I =1 , 4 ) 

386  -  CALL  R0ISC(LFW1P2,1,LABL,4) 

387-  WRITE  (ISTORE)  ( LABL ( I ) , 1=1 ,4 ) 

388  -  WRITE  (ISTORE)  MF 

389  -  GO  TO  440 

390  -  420  CONTINUE 

391  -  DO  425  1=1,3 

392  -  425  LABL(I)  =  4H 

393  -  LA8L(4)=0 

394  -  DO  430  KZ=1,3 

395-  430  WRITE  (ISTORE)  (LABL ( I ) , 1=1 ,4 ) 

396  -  WRITE  (ISTORE)  MF 

397  -  440  CONTINUE 

398  -  IF  (MF.NE.21)  GO  TO  450 

399  -  CALL  RDISC(21,1,LABL,33) 

400  -  WRITE  (ISTORE)  LABL 

401  -  450  CONTINUE 

40  2  -  C 

403  -  CALL  PRINTOUT 

404  -  C 

405  -  GO  TO  750 

406  -  700  STOP  'ABORTSET  TERMINATION' 

407  -  750  STOP  'NORMAL  PROGRAM  COMPLETION* 

408  -  C 

409  -  C 

410  -  SUBROUTINE  BOUNDARY 

411  -  C  INTERNAL  SUBROUTINE  FOR  PROGRAM  BISCAL03  T3  TEST 

412  -  C  SCAN  FOR  FREQUENCY  LIMITS 

413  -  IBDY=1 

414-  GOTO  ( 100,200,300,400,500) , ISQ 

415-  100  IF( (IFl.LE. NFHALF). AND. ( IF2.GT.0))  I8DY=0 

416  -  RETURN 

417  -  200  IF  (IFl.LE. NFHALF)  IBDY=0 

418  -  RETURN 
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419 
4  20 

421 

422 

423 

424 
42  5 
426 
42  7 
428 

42  9 

430 

431 

432 

433 

43  4 

435 

436 

43  7 
4  3  8 

439 

440 

44  1 

442 

443 

444 
44  5 

446 

447 

448 

44  9 

450 

451 

452 

453 

454 

455 

45  6 

457 

458 

459 

460 

461 

462 

463 

464 

46  5 
46  6 

467 

468 

469 

470 

471 

472 

473 

474 

475 
4  76 

477 

478 


300  IF  (IF2.GT.0)  IB0Y=0 
RETURN 

400  IF  KNCPT.LE.NFHALFI.ANO.dFZ.GE.-NFHALFM  IbDY  =  0 
IF  ((NCPT.GT.NFHALFI.AND.IIFl.LE.LPHALFl)  IBDY=0 
RETURN 

500  IF  IIFI.LE.LPHALF)  IBDY=0 
RETURN 
C 
C 

SUBROUl  INE  FREQ  INIT 

C  INTERNAL  SUBROUTINE  FOR  PROGRAM  BISCAL03  TO  INITIALIZE 
C  FREQUENCIES  FOR  A  GIVEN  LINE  OF  SCAN 
GO  TO  I100»200,300,400,500) ,ISQ 
100  IFl=NCPT/2  ;  IF2=NCPT/2 

IF  (MQ0(NCPT,2)  .EQ.  1)  IF1=IF1«-1 

RETURN 

200  IF1=NCPT+1  ;  IF2=-1 
RETURN 

300  IF1=NFIRST-1  ;  IF2=NCPT-IF1 
RETURN 

400  CONTINUE 

IF  (NCPT  .LE.NFHALF)  I  F 1  =NFH  ALF  1  ; 

$I  F2=-1F1+-NCPT 

IF  (NCPT  .GT.NFHALF)  IF1=NCPT«-1  ;  IF2=-1 
RETURN 

500  IFl=NCPT*-NFHALFi-l  ;  IF2=-NFHALF -1 
RETURN 
C 
C 

SUBROUTINE  INDEX 

C  INTERNAL  SUBROUTINE  FOR  PROGRAM  BISCAL03  TO  RELATE 
C  FREQUENCIES  TO  STORAGE  ARRAY  INDICES 
GO  TO  (100,200,300,400,500) ,ISQ 
100  NR0W=IF2  ;  NCOL=IFI 
RETURN 

200  NH0W=IF2+NFHALF*-1  ;  NC0L=IF1 
RETURN 

300  NR0ys=IF2  *,  NCOL- I  FI -NFH  AL  F 
RETURN 

400  NR0W=IF2«-NFHALF*-1  ;  NCOL=  I F 1-NFHAL F 
RETURN 

500  NR0W=IF2*'2*NFHALF*-1  ;  NCOL=  I  F  1-NFHAL  F 
RETURN 

C 

C 

SUBROUTINE  RASTER 

C  INTERNAL  SUBROUTINE  FOR  PROGRAM  BISCAL03  TO  SET  UP  SCAN 
C  PARAMETERS 

GO  TO  ( 100,200,300,400,500) , I SQ 
100  NFIRST=2  ;  NLAST=LPHALF 
RETURN 

200  NFIRST=1  ;  NLAST=NFHALF-1 
RETURN 

300  NFIRST=NFHALF*-2  ;  NLAST  =  LPHALF 
RETURN 

400  NFIRST=1  ;  NLAST=LPHALF-1 
RETURN 

500  NFIRST=1  ;  NLAST=NFHALF-1 
RETURN 
C 
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C 

SUBROUTINE  SUMEREQ 

C  INTERNAL  SUBROUTINE  FOR  PROGRAM  BISCAL03  TO  DETERMINE  WHERE 
C  TO  FIND  SUM  FREQUENCY  COEFFICIENTS 

C  RETURNS  IREA0=1  IF  READING  IS  NECESSARY,  C  OTHERWISE 
IREAD=0 

GO  TO  (100,400,150,200,300)  ,ISQ 
100  IF  (IF3A.GT.NFHALF)  IREAD=1 
RETURN 
150  CONTINUE 

IF  (NSERIES.EQ.l)  RETURN 

IF  (LFWl .EQ.LFW2)  IREAD=1  ;  RETURN 

IF  ((LFW1.NE.LFW2).AN0.  (LFW1P2,EQ.LFW2)  )  IREAD=1  ;  RETURN 
RETURN 

200  CONTINUE 

IF  ((LFW1P2.EQ.LFW1 ) .AND. ( I F3A. LE.NFHAL F ) .AND. 
$(LFW1.N£.LFW2) )  IREAD=1  ;  RETURN 
IF  ((LFWiP2.EQ.LFW2 ) .AND. ( I F3A . GT .NFHALF )  .AND. 
$(LFWi.N£.LFW2)l  IReAD=l  ;  RETURN 
IF  ( (LFW1.EQ.LFW2).AND. {NSERIES.EQ.2) )  IREAD=1  ;  RETURN 
RETURN 

300  IF  (LFWl .NE.LFW2)  IREA0=1 
400  CONTINUE 
RETURN 
C 
C 

SUBROUTINE  PRINTOUT 

C  INTERNAL  SUBROUTINE  FOR  PROGRAM  BISUMOl  TO  PRINT  BI SPECTRAL 
C  INTEGRALS 

IF  (KDISC.EQ.O)  GO  TO  70 
IF  (NSERIES.EQ.l)  GO  TO  50 
WRITE  (KDCB,5000)  2*(LPHALF-1) 

5000  FORMAT  (•  CROSS  SPECTRUM  TOTAL  NUMBER  OF  SUM  •, 

$'FREO*'S:  ',14,'  EACH  BINARY  RECORD  EQUALS  ONE  LINt  • 

$,*0F  PRINTED  OUTPUT ') 

GO  TO  70 

50  WRITE  (KDCB,6000)  LPHALF-1 
6000  FORMAT  ('  AUTO  SPECTRUM  ***  TOTAL  NUMBER  OF  SUM  ', 

$'FREQ"S:  *,14,'  ♦♦♦  EACH  BINARY  RECORD  EQUALS  ONE  LINE  • 
$ , 'OF  PRINTED  OUTPUT • ) 

70  CONTINUE 
NLINES=0 

WRITE  (108,1000) 

1000  FORMAT  (1H1,T26,M  NTEGRALS  OVER  ', 

$‘P  OSITIVE  FREQUENCIES  ALON  E',/) 
NLlNES=NLINES«-2 
WRITE  (108,1200) 

1200  FORMAT  (X,'SUM  NO  I N* ,T 127 , 'S UM* , / , X, • FREQ  SCAN', 
$Ti8,'8R'  ,T26,'BR/N*  , T39 , • BI •  ,T48, • 3  I /N*  , T60 , • BI C • ,T 70 , 
$*BIC/N',T82, *810**2  I B IC**2 ) /N • , T104 , • S ( W3 ) *  (S(W3)**, 

$T127, 'FREQ*  ,/,' SEQ  NO  (N)*,T106, 

$'8IC**2  BIC**2)/N  SEQ  NO*,/) 

NL1^ES=NLINES^■4 

C 

C 

DO  100  I=2,LPHALF 
NLINES=NLINES«-1 

IF  (NLINES.GT.60)  NLINES=6  ;  WRITE  (108,2000)  ; 

SWRITE  (108,1200) 

2000  FORMAT  ( IHl ) 
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565  - 

566  - 

567  - 

568  - 

569  - 

570  - 

571  - 

572  - 

573  - 

574  - 

575  - 

576  - 

577  - 

578  - 

579  - 


KP=I/2 

WRITE  (  108,1500)  I , KP, B RU { 1)  , BRU ( 1 ) / KP , B I U I  I ) , B lU ( I  ) /KP  , 
$BICU(  I),BICU(  n/KP,BIC2U(I)  ,BIC2U(I)/KP, 

»BCSU( I ) , BCSU( I )/KP, I 

1500  FORMAT  ( X , 1 4 , T9 , 1  3, T 14, 3 ( G9 . 3 , X, G9. 3 , 3X ) , X , 
iZ{  G9.3,X,G9.3,4X)  ,14) 

IF  (KOISC.NE.O) 

$WRITE  (KDCB)  I , KP , BRU ( 1) , BRU( I ) / KP , B I Ul I ) ,B IU( I ) / KP , 

SBICUC I) , BICU( I )/KP, 8IC2U( I ) , B I C2U ( I ) /KP , 

$BCSU( I ) ,BCSUI I) /KP, I 
100  CONTINUE 
C 
C 

IF  (NSER lES.EQ. 1)  GO  TO  300 
NLINES=a 

WRITE  (108,4000) 

4000  FQRMAT(1H1,T27,*I  NTEGRALS  INVOLVING 
$,‘N  EGATIVE  FREQUENCIE  S',/) 
NLINES=NLINES4-2 
WRITE  (108,1200) 

NLINES  =  NLINES4-4 
C 
C 

00  200  I=1,LPHALF-1 
NLINES  =  NLINES+-1 

IF  (NL INES.GT.60)  NLINES=6  ;  WRITE  (108,2000)  ; 

$WRITE  (108,1200) 

KP=LPHALF-I 

WRITE  (  108,1500)  I , KP, B RL ( 1) , BRL ( I ) / KP , 6  I L(  I ) , B  I L ( 1  ) /KP  , 
$BICL( I) ,BICL( I)/KP,BIC2L(I) ,BIC2L(I )/KP, 

$BCSL( I ) ,BCSL(  I)/KP,  I 
IF  (KOISC.NE.O) 

$WRITE  (KDCB)  I , KP , B RL ( I ) , BRL ( I ) / KP , B I L (  I ) , B I L (  I  ) /KP  , 

$BICL( I) , BICL( I)/KP, BIC2L( I ) ,BIC2L( I )/KP, 

$BCSL( I),BCSL{ I)/KP,  I 


200 

CONTINUE 

300 

CONTINUE 

RETURN 

END 
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PROGRAM  BIVEC 
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1  -  C  «««<  B  I  V  E  C  0  5  »»»> 

2  -  C  CALCULATES  ROTARY  AUTO-BISPECTRUH  AND  ROTARY  CROSS- BISP ECTKUM 

3  -  C  FOR  ONE  OR  TWO  VECTOR  SERIES  AND  DETERMINES  CONFIDENCE  LEVELS 

4  -  C  FOR  BICOHERENCES. 

5  -  C  GENERATES  TWO  OR  FOUR  DISC  FILES  FOR  TRANSMITTAL  TO 

6  -  C  PLOTTING  PROGRAM. 

7  -  C  PROGRAMMER:  GERARD  H,  MART INEAU 

8  -  C  ORIGINATOR:  MELBOURNE  G.  BRISCOE 

9  -  C  DATE  :  OCT  17,  1977 

0  -  C  *♦*♦♦♦♦♦♦♦♦♦♦  ♦*♦*♦♦♦♦♦♦♦ 

11  -  DIMENSION  Wll (2560) ,W12(2560),W2l(2560) ,W22(2560», 

12  -  $OM(2560,4),SQl(35,35),SQ2(35,35),W31(80),W32(B0), 

13  -  $K8IN(200),ABINI200) ,C0NF(10),BCL(10),KARD(20),LW(6) 

14  -  DIMENSION  LABLI 33) , PHS£RR(2 ) 

15-  EUUIVALENCE  ( Wll ,0M ) , ( W 12 ,0M( 1 , 2) ) , ( W2l ,0M( 1 ,3 ) ) , 

16-  S(W22»0M{1,4)) ♦(KBIN,A8IN), 

17  -  $(LW(1) ,LW11) , (LWI2) ,LW12) ,( LW(3 ) ,LW21), {LW(4) ,LW22) , 

18-  S(LW(5)«LW31)t (LW(6) »LW32) 

19  -  DOUBLE  PRECISION  A1 1 , B1 1 , A1 2 , 6 1 2 , A2 1 , B2 1 , A22 , B22 , A3  1 , B3 1 , 

20  -  $A32,B32,P1U,P2U,P3U,P1V,P2V,P3V, 

21  -  SRNUMU,RNUMV,RDENU,RDENV,RBUR,RBUI ,R8VR,RBVI » 

22  -  SU1R,U1I,U2R,U2I  ,U3R,U3I tVlR,VlI ,V2RfV2I  iV3R,V3I ,RNPCS, 

23  -  $RMOOU,RMODV,RBURT,RBUIT,RBVRTfRBVIT,ANPCS 

24  -  COMMON  /PRIME/  NPRIME(65) 

25  -  DATA  NPRIME/ 


26  - 

$ 

16, 

24, 

32, 

40  , 

48, 

64t 

72, 

80, 

96, 

120, 

27  - 

$ 

123, 

144, 

160, 

200  , 

216, 

240,  256, 

288, 

320, 

360, 

28  - 

$ 

384, 

400, 

432, 

480  , 

512, 

576, 

600, 

640, 

648, 

720, 

29  - 

$ 

768, 

BOO, 

864, 

960  , 

1024, 

1080,1  152, 

1200, 

1280, 

1296, 

30  -  $1440,1536,1600,1728,1800,1920,1944,2000,2048,2160, 

31  -  $2304,2400,2560, 2592,2880,2916,3000,3072,3200,3240, 

32  -  $3456,3600,3848,3883,4000/ 

33  -  NAMELIST  1 0  AT  ST  ART  ,  MF  ,  I  STORE  1 ,  I  ST  0RE2 ,  B  I  N  S I  ZE  ,  R  B I  CL  I M  , 

34  -  $IHI ,K8i,KB2,K0NF,LISTBI ,IDUMP,LABREAD,IFQURIER, INORM, 

35  -  $IST0RE3,IST0RE4,ISQaUT, IHANN,SIGLVL 

36  -  ISQ0=35  ;  IS0M=2560 

37  -  Pl  =  3.14159265  ;  TW0PI=2.*PI 

38  -  DTR=PI/180.  ;  RTD=180./P1 

39  -  ISQ0UT=0  ;  IHANN=1 

40  -  SIGLVL=-1  ;  PHSERRI2)=0 

41  -  CALL  ABORTSET (700S, 1) 

42  -  CALL  BIVCTRL 

43-  IF  ((LISTBI. NE.O). AND. ( INORM. EQ.O))  WRITE  (108,1321) 

44  -  1321  FORMAT  I  /  ,T3  ,  •  F 1'  ,  T  9  ,  •  F  2  •  ,T  15,  •  F3  •  ,  T20,  •  RBI  COH  RBIPHASE* 

45  -  $,T39, •/<RB>/* ,T51,*<R£AL(RB)>',T64, •<IMAG(RB)>' ,T76, 

46  -  $*<P(Wi)DW>' ,T88,*<P(W2)DW>» ,T100,'<P(W3)DW>*,T111, 

47  -  $ 'SURF (PR0D<P>) • ,T125, 'PHSERR  •  ,/ ) 

48-  IF  ( (LISTBI .NE.O) .AND. ( INCRM.NE .0))  WRITE  (108,1431) 

49  -  1431  FORMAT  ( / , T3,  • F 1 • , T9  ,  • F 2 •  ,T 1 5 , • F3 ' , T20, • RBI COH  RBIPHASE* 

50  -  $  ,T38,  •  <R£AL  (RB*  •  )>•  ,T52,  •<IMAG(  RB"  )>•  ,T65, 'PHSERR*  ,/ ) 

51  -  NPCS=NPC2-NPCH-1 

52-  IF  ((NPCS.EQ.l) .AND.l IHANN.EQ.l  ))  IHANN=0  ;  OUTPUT 

53  -  $*IHANN  HAS  BEEN  SET  TO  0.  CAN"T  OVERLAP  WITH  ONE  PIECE* 

54-  IF  (IHANN.EQ.l)  E00F=36 .♦NPCS*NPCS/ I 19*NPCS-1 ) 

55  -  IF  (IHANN.EQ.O)  ED0F=2*NPCS 

56  -  IF  (  S  IGLVL.lt. 0)  SI  GLVL  =  SQRT  (  6. /EDOF ) 

57  -  LPATH£=LPIECE/8  ;  L PQU= LP I E CE/4  ;  LPHAL F= LP I ECE/2 

58  -  LP38=3*LPATHE  ;  I QN0=2*NPIECES*LPATHE 
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59 

60 
61 
62 
63 
6A 

65 

66 

67 

68 

69 

70 

71 

72 

73 

74 

75 

76 

77 

78 

79 

80 
81 
82 

83 

84 

85 

86 

87 

88 

89 

90 

91 

92 

93 

94 

95 

96 

97 

98 

99 
100 
101 
102 

103 

104 

105 

106 

107 

108 

109 

110 
111 
112 

113 

114 

115 

116 

117 

118 


IQU1=IDATSTART+NPIECES  ;  IQU2  =  I QU 1  I QNO 
IQU3=IQU1*-2*IQN0  ;  IQU4=  IQUl  +  3*  IQNO 
C  START  OF  LOOP  FOR  /W2/>/Wl/ 

KPASS=1 
50  CONTINUE 

C  INITIALIZE  RASTER  AT  ZERO 
ISQ=0 


C 

C 

C  STARTING  POINT  FOR  RASTER  LOOP: 

100  CONTINUE 
C  OUTPUT  TO  DISC 

IF  ((  IDUMP.EQ.OI.OR.nSQ.EQ.On  GO  TO  102 
KSTi=ISTOREl  ;  KST2=IST0RE2 

IF  (KPASS.EQ.2)  KST1=IST0RE3  ;  KST2=IST0RE4 
WRITE  IKSTl)  t  (SQKI  f  Jl»  I  =  lt  LPATHE)  f  J=l#LPATHE) 
WRITE  (KSTZ)  I (SQ2(I ,J». 1=1, LPATHE), J=l, LPATHE) 
102  CONTINUE 
C  INCREMENT  RASTER 
ISQ=ISQi-l 

IF  (ISQOUT.NE.O)  OUTPUT  I 5Q 
C  IS  RASTER  LIMIT  EXCEEDED? 

IF  nSQ.GT.16)  GO  TO  300 

C  SET  STORAGE  ARRAYS  SQ1,SQ2  TO  -999.  IF  DUMPING 
IF  (IDUMP.EQ.O)  GO  TO  110 
C 

C 

DO  105  I=1,ISQD 
C 

DO  105  J=1,ISQD 
SQKI  ,  J)  =-999. 

105  SQ2(I, J)=-999. 

C 

C 

110  CONTINUE 

CALL  FREQBIAS12 

IF  (( ISQ.NE.ll) .AND.(ISQ.NE.16) )  GO  TO  125 
C 
C 

DO  120  1=1, ISOM 
WIKI  )=0. 

120  W12(I)=0. 

C 

C 

125  IF  l( ISQ.NE.16) .OR. { ISW.NE.3) )  GO  TO  135 
C 
C 

DO  130  1=1, ISOM 
W2KI  )=0. 

130  W22{  n=o. 


C 

C 


135 


137 


CONTINUE 

IF  (KPASS.EQ.l)  GO  TO 
LWP=LW11  ;  LWQ=LW12 
LW11=LW21  ;  LW12=LW22 
CALL  READW1W2 
IF  (KPASS.EQ.l)  GO  TO 
LWP=LW11  ;  LWQ=LW12 
LW11=LW21  ;  LW12=LW22 


137 

;  LW21=LWP 

138 


LW22=LWQ 


LW21=LWP  ;  LW22=LWQ 


I8l 


119-  X  WRITE  1108,1717)  ( ( 0M( I , J) , 1=1 , 4) , J=1 ,4 ) 

120  -  138  CALL  RASTER 

121  -  C  INITIALIZE  SCAN  (SUM)  FREQUENCY 

122  -  NCPT=IFIRST-1 

123  -  C 

124  -  C 

125  -  C  STARTING  POINT  FOR  SCAN  LOOP: 

126  -  140  CONTINUE 

127  -  C  INCREMENT  SCAN 

128  -  NCPT=NCPT+1 

129  -  X  OUTPUT  NCPT 

130  -  C  CHECK  FOR  END  OF  RASTER 

131  -  IF  (NCPT .GT.ILAST)  GO  TO  100 

132  -  IF  (KPASS.EQ.l)  GO  TO  145 

133  -  LWP=LW11  ;  LWQ=LW12 

134  -  LW11=LW21  ;  LW12=LW22  ;  LW21=LWP  ;  LW22=LWQ 

135  -  145  CALL  READW3 

136  -  IF  (KPASS.EQ.l)  GO  TO  150 

137  -  LWP=LW11  ;  LWQ=LW12 

138  -  LW11=LW21  ;  LW12=LW22  ;  LW21=LWP  ;  LW22=LWQ 

139-  X  WRITE  (  108,7777)  ( W 31 ( N ) ,N=1 , 2 )  ,  ( W32( N ) ,N  =  1 , 2 ) 

140  -  X7777  FORMAT  ( X , 2 ( 2 F2 .0 ,4 X ) ) 

141  -  150  CALL  FREQINIT 

142  -  C  INITIALIZE  FREQUENCIES  1,2 

143  -  IF1=IF1-1  ;  IF2  =  IF2«-1 

144  -  C 

145  -  C 

146  -  C 

147  -  C  STARTING  POINT  FOR  FREQ.  1,2  LOOP  (GRID  POINT  LOOP) 

148  -  155  CONTINUE 

149  -  C  INCREMENT  FREQUENCIES  1,2 

150  -  IF1=IF1*-1  ;  IF2=IF2-1 

151  -  IF2ABS=ABS(  IF2) 

152  -  C  CHECK  FOR  END  OF  SCAN 

153  -  CALL  BOUNDARY 

154  -  IF  (IBDY.EQ.l)  GO  TO  140 

155  -  C  BEGIN  CALCULATIONS 

156  -  R8UR=RBUI=RBVR=RBVI=0. 

157  -  P1U=P2U=P3U=P1V=P2V=P3V=0. 

158  -  C 


159 

160 
161 
162 

163 

164 

165 

166 

167 

168 

169 

170 

171 

172 

173 

174 

175 

176 

177 

178 


C 

DO  200  I=NPC1,NPC2 
IF3=IFH-IF2 

IA1=(  IFl-IFBl-1  )*2*NPIECES<-I 
IB1=IAI4-NPIECES 

IA2=( IF2ABS-IFB2-1) *2*NPIECES*I 
IB2  =  IA2»-NPIECES 
A11=W11(IA1)  ;  B11=W11(IB1) 

A12=Wl2(iAl)  ;  B12=W12(IB1) 

IF  (ISW.E0.3)  GO  TO  170 

GO  TO  (  160,160,  170,  170,  160,160,170,  170,  170,170,170,  170, 
$170,170, 160,160), ISQ 
160  A21=W11(IA2)  ;  B21=W11(IB2) 

A22=W12(IA2)  ;  B22=W12(IB2) 

GO  TO  180 

170  A21=W21(iA2)  ;  821=W21(IB2) 

A22=W22(IA2)  ;  B22=W22(IB2) 

180  A31=W31(n  ;  B31=W3l (NP lECESfrl ) 

A32=W32(I)  ;  B32=W32(NPIECES«-I) 


WRITE  (108,1717)  A1 1  ,A1 2 ,B1 1 ,B1 2 , A2 1 , A22 , 82 1 , 822 , 


X 


182 


X  $A31,A32,B31,B32 
X1717  FORMAT  ( X,3(4F4.0,4X) ) 

U1R=A11*-B12  ;  U11=A12-B11 
U3R=A3H-B32  ;  U3I=- A32<-B3l 
VIR=A11-B12  ;  V1I=A12«-811 
V3R=A31-B32  ;  V3I=-A32-B31 
IF  (IF2.lt. 01  GO  TO  185 
U2R=A2i«-B22  ;  U2I=A22-821 
V2R»A21-822  ;  V2I=A224^S21 

P2U=P2U«-U2R»*24-U2I**2  ;  P2V=P2V  ♦•V2R**2fV2  I **2 
GO  TO  190 

185  U2R=A21-B22  ;  U2I=A22«-B21 
V2R=A2H-822  ;  V2I=A22-B21 

P2U=P2U<-U2R**2«-U2I**2  ;  P 2V=P2V  «-V2R»*2f  V2 1  **2 
190  CONTINUE 

IF  (INORM.EQ.O)  GO  TO  195 

RBURT=U1R*U2R*U3R-01I*U2I*U3R-U1R*U2I*U3I-U1I=*=U2R*J3I 
RBUIT=U1R*U2I  ♦U3R+U1I  ♦U2R*U3R<-U1R*U2R*U3I-U1I*U2  I*U3I 
RBVRT=V1  R*V2R*V3R-V1I»V2I*V3R-VIR<‘V2I*V3I-V1I*V2R*V'3I 
RBVIT=V1R*V2I  *V3R  +  V1I  ♦V2R*V3R+V1R*\/2R«V3I-V1  I<'V2I*V3I 
RMOOU=DSQRT  (R  BURT**2*-RBU  IT**2  » 

RBUR=RBUR+RBURT/RMODU  ;  RBU I =RBUI +R8UIT/RM0DU 
RMODV=DSGRT(RBVRT**2<4iBVIT*<'2) 

RBVR=RBVR«-RBVRT/RMODV  ;  RBV  I  =RB  VI  ♦•RBV IT/R MODV 
GO  TO  200 
195  CONTINUE 

P1U=P1U«-UIR=*'*2+U1I**2  ;  P3U=P3U«-U3R*»2<-U3I**2 
P1V=PIV<-V1R**2+VI  I«*2  ;  P3V  =  P3V»-V3R**2+V3I**2 
RBUR=R6UR*-UIR*U2R*U3R-U1I*U2I*U3R-U1R»U2I*U31-U1I*U2R*U3I 
RBUI=RBU  I+U1R*U2I*U3R*-U1I  ♦U2R*U3R<-U1R*U2R«U3I-U1  I*U2I*U3I 
RBVR=R8VR*'V1R*V2R*V3R-V1  I*V2I*V3R-V1R*V2I*V3I-Vi  I»V2R*V3I 
RBVI  =  RBVI*-V1R*V2I*V3R  +  V1I*V2R*V3R<-V1R*V2R*V3I-V1I*V2I*V3I 

200  CONTINUE 
C 
C 

IF  (INORM.EQ.O)  GO  TO  202 
RBICU=(  OSQRTI  RBUR**2fRBUI4*2)  )/ANPCS 
RBICV=(OSQRT(  RBVR**2<-RBVI**2»  »/  ANPCS 
GO  TO  204 
202  CONTINUE 

RNUMU=DSQRT(RBUR**2+RBUI**2)  ;  ROENU=DSQRT I P1U*P2U*P3U) 
R8ICU=RNPCS*RNUMU/R0ENU 

RNUMV=DSGRT (RBVR**2+R8V1**2 )  ;  ROENV=DS QRT ( P 1 V*P2V*P3V J 

RBICV=RNPCS*RNUMV/RDENV 
204  CONTINUE 

R8PHU=DATAN(RBUI,R8UR ) 

RBPHV=DATAN(RBVI  ,R8VR) 

RBPHU=RTO*RBPHU  ;  R BPHV =RTD*RBPHV 
C  SORT  ROT  BIC'S  IF  CALLED  FOR 

IF  (KONF.NE.O)  CALL  CB I N( RB ICUt 1 J  ;  CALL  CB IN (R B I CV , 2 ) 

C  PRINT  ROT  BIC'S  WITHIN  SPECIFIED  LIMITS 
IF  (LISTBI.EQ.O)  GO  TO  219 
JF1=IF1  ;  JF2=IF2 

IF  IKPASS.EQ.2)  JF1=IF2  ;  JF2=IF1 
IF  (INORM.NE.O)  GO  TO  212 

IF  ((RBICU.LE.CONFl ).0R.IRBICU.GT.C0NF2))  GO  TO  208 
IF  (IHANN.NE.l)  GO  TO  205 
IF  (RBICU.GE.SIGLVLI  NPH=1  ; 

$PHSERR(  1)  =  57.296*ASIN(  l.96/SQRT(ED0F)/RBICU)  *,  GO  i  O  206 
NPH=0  ;  GO  TO  206 
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205  CONTINUE 

IF  t(  IHANN.EQ.O  )  .  AND.  (RBICU.GE.SIGLVD)  NPH  =  1  ; 

SPHSERRIl )=SQRT(2.*NPCS)  ;  GO  TO  206 
NPH=0 

206  CONTINUE 

WRITE  (108,20001  JF I , JF2 , IF3 , RB ICU, RBPHU, RNUMU/ NPI ECES, 
$RBUR/NPIECES,RBUI/NPIECES,P1U/NPIECES,P2U/NPIECES, 
$P3U/NPIECES  ,RDENU/NPIECES*<‘1.5,NPH,  (PHSERRI  I  )  ,  I  =  1,NPH) 
2000  FORMAT  I  X , I  4, 2( 2X , I  4 ) , 3 X, F5 . 3 , 3X, F6. 0,-X , IH  ,3(2X,E11.3J 
$,3(  1X,E11.3),2X,E11.3,3X,N(F5.U  ) 

208  CONTINUE 

IF  ((RBICV.LE.CONFl ).0R.(RBICV.GT.C0NF2))  GO  TO  219 
IF  (IHANN.NE.l)  GO  TO  209 
IF  (R8ICV.GE.SIGLVL)  NPH=1  ; 
iPHSERRIi )=57.296*ASIN( 1.96/SQRT(ED0F)/RBICV)  ;  GO  TO  210 
NPH=0  ;  GO  TO  210 

209  CONTINUE 

IF  ((  IHANN.EQ.OJ.  WD.IRBICV.GE.SIGLVLH  NPH  =  l  ; 
iPHSERRI 1 )=SQRT{2.*NPCS)  ;  GO  TO  210 
NPH=0 

210  CONTINUE 

WRITE  (  108,2000)  -J F 1 JF 2, - 1 F3 ,R8I CV ,R BPHV , RNUMV/N P I  EC ES 
$,RBVR/ NPI ECES ,R BV I / NP I ECE S, P 1 V/ NP I ECES , P 2 V/ NP I  EC ES, 
$P3V/NPIECES,RDENV/NPIECES** 1. 5,NPH, (PHSERRI I ) ,I=1,NPH) 

GO  TO  219 

212  CONTINUE 

IF  ((RBICU.LE.C0NF1).0R.(R8ICU.GT.C0NF2))  GO  TO  216 
IF  (IHANN.NE.l)  GO  TO  213 
IF  (RBICU.GE.SIGLVD  NPH=1  ; 

$PHS£RR(1)=57.296*ASIN(1.96/SQRT(ED0F)/RBICU)  ;  GO  TO  214 
NPH=0  ;  GO  TO  214 

213  CONTINUE 

IF  ({  IHANN.EQ.O). AND. (RBICU.GE.SIGLVD)  NPH=1  ; 

$PHSERR(1 )=SQRT( 2.*NPCS)  ;  GO  TO  214 
NPH=0. 

214  CONTINUE 

WRITE  (108,2100  )  JF 1 , JF2 , IF  3 , RB ICU, RB PHU, RBUR/NP I ECES , 
SRBUI/NPI ECES,NPH, (PHSERRI I ) , 1=1 ,NPH) 

2100  F0RMAT(X,I4,2(2X,I4),3X,F5,3,3X,F6.0,-X,1H  , 
$2(3X,E11.3),3X,N(F5.1)) 

216  CONTINUE 

IF  ((RBICV.LE.CONFl >. OR. (RBICV.GT.C0NF2))  GO  TO  219 
IF  (IHANN.NE.l)  GO  TO  217 
IF  (RBICV.GE.SIGLVL )  NPH=1  ; 

$PHSERR(1)=57.296*ASIN(1.96/SQRT(ED0F)/R8ICV)  ;  GO  TO  218 

NPH=0  ;  GO  TO  218 

217  CONTINUE 

IF  (I  IHANN.EQ.O).  AND. (RBICV.GE.SIGLVL))  NPH=1  ; 
SPHSERR(i)=SQRT(2.*NPCS)  ;  GO  TO  218 
NPH=0 

218  CONTINUE 

WRITE  (108,2200)  - J F 1 , - JF2 , - I F3 , RBI CV, R BPHV ,R0VR/NP 1 ECE S , 
$RBVI/NPI ECES, NPH, (PHSERRI I) ,1=1 ,NPH) 

2200  FORMAT  ( X , 14 , 2( 2X , I  4 ) , 3 X, F5 . 3 , 3X, F6. 0,- X, IH  , 

$2I3X,eil.3)  ,3X,NIF5.1)  ) 

219  CONTINUE 

C  COMMIT  RBICU  TO  SQl  AND  RBICV  TO  SQ2 
IF  (lOOMP.EQ.O)  GO  TO  240 
NC1=IFI-IFB1 

IF  (IF2.lt. 0)  NR1  =  IF2  +  H-LPATHE  +  IFB2  ;  GO  TO  220 
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299 

300 
30  1 
302 
30  3 

304 

305 
3  06 

307 

308 

309 

310 

311 

312 

313 

314 

315 

316 

317 

318 

319 

320 

321 

322 

323 

324 

32  5 

326 

327 

328 

329 

330 

331 

332 

333 

334 

335 

336 

33  7 

338 

339 

340 

341 

342 

343 

344 

345 

346 

347 

348 

349 

350 

351 

352 

353 

354 

355 

356 

357 

358 


NR1=IF2-IFB2 
220  SQKNRlf  NCI)=RB1CU 

NC2=rFBH-LPATHE-IFH-l 

IF  1IF2.lt. OJ  NR2=-IFB2-IF2  ;  GO  TO  230 
NR2  =  IFB2+LPATHE-IF2«-l 
230  SQ2(MR2tNC2)=RBICV 
240  CONTINUE 
C 

C  ENO  OF  FREQ.  1»2  LOOP  (GRID  POINT  LOOP) 

GO  TO  155 
C 
C 

300  CONTINUE 

C  OUTPUT  APPROPRIATE  LABELS  TO  DISC 
IF  (lOUMP.EQ.O)  GO  TO  400 
IF  ILABREAD.EQ.O)  GO  TO  360 
C 

DO  350  I=lf6 

350  CALL  RDlSCCLWin,  1,  LABL  {4*I-3)*4) 

C 

360  CONTINUE 
C 

c 

KST1=IST0REI  ;  KST2=IST0RE2 

IF  (KPASS.EQ.2)  KST1=IST0RE3  ;  KST2=IST0RE4 
DO  370  I=lf6 

WRITE  IKSTl)  (LABLCK)fK=4*I-3,4*I) 

WRITE  (KST2)  ( LABLIK ) ,K=4*I-3, 4*1 ) 

370  CONTINUE 
C 
C 

WRITE  (KSTl)  MF 

WRITE  (KST2)  MF 

C 

DO  380  1=1,33 
380  LABLl I) =4H 

IF  ((MF.NE.21 l.OR.l IFOURIER.EQ.O) )  GO  TO  390 
C 

CALL  RDISCI21,1 ,LA8L,33) 

390  CONTINUE 

WRITE  IKSTl)  LABL 

WRITE  (KST2)  LABL 

400  CONTINUE 

C  END  OF  LOOP  FOR  /W2/>/Wl/ 

IF  ((  ISW.EQ.3  ).AND.  (KPASS.EQ.l)  )  KPASS=2  ;  GO  TO  50 
C  DETERMINE  CONFIDENCE  LEVELS  IF  CALLED  FOR 
IF  (KONF.NE.O)  CALL  CONFIDENCE 
C 

GO  TO  800 

700  STOP  'ABORTSET  TERMINATION* 

C 

800  STOP  'NORMAL  PROGRAM  COMPLETION* 

SUBROUTINE  BIVCTRL 

C  INTERNAL  SUBROUTINE  FOR  PROGRAM  8IVEC01  TO  INITIALIZE, 

C  AND  READ  AND  CHECK  INPUT  PARAMETERS. 

IDUMP=l 

MF=21  ;  IDATSTART=5 

ISTOREl=l  ;  IST0RE2=2  ;  IST0RE3=3  ;  IST0RE4=4 
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359  - 

360  - 
36  1  - 

362  - 

363  - 

364  - 

365  - 

366  - 

367  - 
36  8  - 

369  - 

370  - 

371  - 

372  - 

373  - 

374  - 

375  - 

376  - 

377  - 

378  - 

379  - 

380  - 

381  - 

382  - 

38  3  - 

384  - 

385  - 

386  - 

387  - 

388  - 

389  - 

390  - 

39  1  - 
39  2  - 

393  - 

394  - 

395  - 

396  - 

397  - 

398  - 

399  - 

400  - 

401  - 

402  - 

403  - 

404  - 

405  - 

406  - 

407  - 

408  - 

409  - 

410  - 

411  - 

412  - 

413  - 

414  - 

415  - 

416  - 

417  - 

418  - 


IHI  =  1 

LABREAD=1  ;  IFOURIER=l 

BINSIZ£=0.01  ;  RBICLIM=1.5  ;  KB1=K82=1  ;  KaNF=0 
KOVER=0  ;  LIST8I=0 
MTOT=0  ;  LIMPCS=150 
INORM=0 
C 
C 

00  20  1=1,200 
20  K8IN(I)=0 
C 
C 

DO  40  1=1,33 
40  LA8HI)=4H 
C 
C 

INPUT 

OUTPUT  I  OATSTART,MF , ISTOREl , I ST0RE2, ISTORE3, IST0RE4, 
$BINSIZE,RBICLIM  ,IHI  ,K81 ,KB2 ,KONF, LISTBI  , I  DU HP , L A8RE AO , 
$IFOURIER,INORM, IHANN 
CALL  0PAR(NERR,MF,1, 1,KSUM, 512) 

READ  (105,1000)  KARD 
1000  FORMAT  (20A4) 

WRITE  (108,1100)  KARD 
1100  FORMAT  (X,20A4) 

DECODE  ( 80, 1200, KARD)  L Wl 1 , LW 12 ,L W2 1 , LW 22 ,L W3i , L W32 , 
$NPIECES,LPIECE,NPC1,NPC2,C0NF1,C0NF2 
1200  FORMAT  (I2G) 

IF  (NPC2.GT.NPIECES  )  OUTPUT  NPC 2 , NP I ECE S , 

S'LAST  PIECE  TO  AVG  GREATER  THAN  NO  OF  PCS'  ;  STOP 
ANPCS=DFLOAT { NP I ECES ) 

RNPCS=DSQRT (ANPCS) 

IF  I(LW11.NE.LW21 ).0R. (LW12.NE.LW22) )  GO  TO  30 
IF  (ILW31.EQ.LW11).AND. (LW32.EQ.LW12) )  ISW=1  ;  GO  TO  5u 
ISW=2  ;  GO  TO  50 
30  CONTINUE 

IF  ( ( (LW31.EQ.LW11) . AND. I LW32. E Q. LW 12 ) ) .OR. 

$(  (LW31.E(j.LW21)  .AND.  (LW32.EQ.LW22)  )  )  1SW=3  ;  GO  TO  50 

OUTPUT  LW11,LW12, LW21,LW22, LW31  ,LW32, 

S'NO  MORE  than  TWO  DIFFERENT  VECTOR  SERIES  ALLOWED*  ;  STOP 
50  CONTINUE 

C  CHECK  FOR  EXISTENCE  OF  DC8  ASSIGNMENTS  FOR  OUTPUT  FILES 
IF  IIDUMP.EQ.O)  GO  TO  80 

N1=IST0RE1  ;  N2=ISTORE2  ;  N3=IST0RE3  ;  N4=IST0RE4 
IF  ( ISW.EQ.3)  GO  TO  60 
IF  (Ni.NE.N2)  GO  TO  70 
OUTPUT  I STOREl, IST0RE2  ;  GO  TO  65 
60  CONTINUE 

IF  ((N1.NE.N2 ).AND. ( Nl. NE .N3 ) . AND. ( N1 .N E .N4 ) . AN 0 . 
$(N2.NE.N3).AND. (N2.NE.N4).AND.(N3.NE.N4))  GO  TO  70 
OUTPUT  ISTOREl, IST0RE2, IST0RE3, IST0RE4 
65  OUTPUT  'TWO  OUTPUT  DCB"S  HAVE  BEEN  SET  EOUAL  CAN"T  DO.' 

$  ;  STOP 
70  CONTINUE 

CALL  GETDCBI  ISTOREl  , LOCO 
CALL  GETDCB ( IST0RE2 ,LOCC) 

IF  (ISW.NE-3)  GO  TO  80 
CALL  GETDCBI IST0RE3,L0CC) 

CALL  GETDCB(IST0RE4,L0CC) 

80  CONTINUE 
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419 

420 

421 

422 

423 

424 

42  5 

426 

427 

428 

429 

430 

431 

432 

433 

434 

43  5 
436 

43  7 

438 

439 

44  0 

441 

442 

443 

444 
44  5 

446 

447 

448 
44  9 

450 

451 

452 

453 

454 

455 

456 

457 

458 

459 

460 

461 

462 

463 

464 

465 

466 

467 

468 

469 

470 

471 

472 
4  73 

474 

475 

476 

477 

478 


C 

DO  100  1=1,65 

IF  (LPIECE.EQ.NPRIMEI n )  GO  TO  150 
100  CONTINUE 
C 
C 

WRITE  (108,1250)  NPRIME  ;  STOP 
1250  FORMAT  ('PIECE  LENGTH  MUST  BE  FROM  FOLLOWING  LIST:',/, 
$(10(X,I7) ) ) 

150  CONTINUE 

IF  (NPIECES.GT.LIMPCS)  WRITE  (108,1275)  ;  STOP 

1275  FORMAT  ('NUMBER  OF  PIECES  MUST  NOT  EXCEED  150') 

IF  (KONF.EQ.O)  GO  TO  300 
READ  (105,1000)  KARD 
WRITE  (108,1100)  KARD 

DECODE  (  80,3000  , KARD)  NCONF  ,  NCONF,  (CONF  (  I ) ,  1  =  1,  NCUNF  ) 

3000  FORMAT  (G,NG) 

NBINS  =  INT(RBICLIM/8  INSIZE+0.5) 

IF  (NBINS.GT.200)  WRITE  (108,3050)  ;  STOP 
3050  FORMAT  ('NUMBER  OF  BINS  MUST  NOT  EXCEED  200') 
RBICLIM=N8INS*BINSIZE 
WRITE  (108,4000)  RBICLIM 

4000  FORMAT  ('ADJUSTED  ROT  BICOH  LIMIT,  HOLDING  BINSIZE 
$'AS  INPUT  ',F6.2) 

300  CONTINUE 
RETURN 

Qi^^::^fi*^^t*’i‘***‘*^*^i^***************‘******************^**********^** 

SUBROUTINE  FREQBIAS12 

C  INTERNAL  SUBROUTINE  FOR  PROGRAM  BIVECOl  TC 
C  RETURN  FREQUENCY  BIASES  FB1,FB2 

GO  TO  (10,10,30,30,50,50,70,70,90,90,110,110,130,140, 
$150,160) , ISQ 
10  IFB1=IF32=0.  ;  RETURN 
30  IFB1=LPATHE  ;  IFB2=0.  ;  RETURN 
50  IFB1=LPATHE  ;  IFB2=LPATHE  ;  RETURN 
70  1FB1=LPQU  ;  IFB2=LPATHE  ;  RETURN 
90  IFB1=LPQU  ;  IFB2=0.  ;  RETURN 

110  IFB1=LP38  ;  IFB2=0.  ;  RETURN 

130  IFB1=LP38  ;  IFB2=LPATHE  ;  RETURN 
140  IFB1=LP38  ;  IFB2=LPQU  ;  RETURN 
150  IFB1=LPQU  ;  IFB2=LPQU  ;  RETURN 
160  IFB1=LP38  ;  IFB2=LP38  ;  RETURN 

SUBROUTINE  READW1W2 

C  INTERNAL  SUBROUTINE  FOR  PROGRAM  BIVECOl 
C  TO  FILL  BUFFERS  FOR  FREQUENCIES  1,2 

GO  TO  (10,20,30,40,50,60,70,80,90,100,110,120,130,140, 
$150,160) , ISQ 
C 

10  DO  13  1=1,2 

13  CALL  ROISC(LW(I ),IQU1,0M(1, I),IQNO) 

C 

DO  18  1  =  1,2 

GO  TO  (14,15, 16), ISW 

14  CALL  RDISC(LW(I  ),IQU2,0M(l,H-2)  ,IQNO)  ;  GO  TO  18 

15  CALL  RDISCILWdM),  IQU1,0M(1,I«-2),IQN0)  ;  GO  TO  13 

16  CALL  RDI  SC(LW{H-2)  ,  IQUl  ,0M(  1,1  +  2)  ,  IQNO) 
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479 

- 

18 

CONTINUE 

480 

- 

C 

481 

- 

20 

CONTINUE 

482 

- 

IF  (ISW.NE.2)  GO  TO  26 

483 

C 

48  4 

- 

DO  24  I=lf2 

485 

- 

24 

CALL  RDISCI LW( 1+4), IQUl ,OM( 1,1+2) ,IQNO) 

486 

- 

c 

487 

- 

26 

RETURN 

488 

- 

c 

489 

30 

00  35  1=1,2 

490 

- 

CALL  RDISC(LWII),IQU2,0MI1, I),IQNO) 

491 

- 

IF  (1SW.NE.3)  CALL  RDI SC RW  ( I +2  )  ,  IQU 1 ,0M(  1 , 

1+2) , IQNO) 

492 

35 

CONTINUE 

493 

- 

c 

494 

- 

40 

RETURN 

495 

- 

c 

496 

- 

50 

DO  58  1=1,2 

497 

— 

GO  TO  (54,55,56),  ISW 

49  8 

54 

CALL  ROISC(LW(I ) , IQU3,0M( 1, 1+2) ,IQNO)  ; 

GO 

TO 

58 

499 

- 

55 

CALL  RDISC(LW(I+4),  IQU3,0M( 1,1  +  2), I  UNO) 

f  G  C,! 

TO  58 

500 

- 

56 

CALL  RDI SC(LW(I +2) , IQU2 ,0M( 1, 1+2) , IQNO) 

501 

- 

58 

CONTINUE 

502 

c 

503 

- 

RETURN 

504 

60 

IF  (ISW.EQ.3)  RETURN 

505 

- 

c 

506 

- 

DO  68  1=1,2 

507 

— 

GO  TO  (64, 65), ISW 

508 

64 

CALL  RDISCILWd), IQUl, 0M(1, 1+2), IQNO)  ; 

GO 

TO 

68 

509 

65 

CALL  RDISC(LW (1+4 ),  I QUl , OM ( 1 , I  +  2 ) , IQNO) 

510 

- 

68 

CONTINUE 

511 

- 

c 

512 

- 

RETURN 

513 

- 

c 

514 

- 

70 

DO  73  1=1,2 

515 

- 

73 

CALL  ROISC(LW(I), IQU3,0M(1, I), IQNO) 

516 

r 

L. 

517 

- 

IF  (ISW.EQ.3)  RETURN 

518 

- 

C 

519 

DO  78  1=1,2 

520 

- 

CALL  RDI SC(LW(I+2), IQU2,0M(  1, I+2),IQN0) 

52  1 

- 

78 

CONTINUE 

522 

C 

523 

- 

80 

RETURN 

524 

- 

c 

525 

90 

DO  95  1=3,4 

526 

- 

95 

CALL  RDISCILWd  ),IQU1,0MI1,  I),IQNO) 

527 

- 

c 

528 

100 

RETURN 

529 

- 

c 

530 

- 

110 

DO  115  1=1,2 

531 

- 

115 

CALL  RDISCILWd  ),  IQU4,0Md,  I  )  ,  I  QNO-NPIECES) 

532 

- 

c 

533 

- 

120 

RETURN 

534 

- 

c 

535 

- 

130 

DO  135  1=3,4 

536 

- 

135 

CALL  RDISCILWd  ),  IQU2,0M(  1,  I  ),  IQNO) 

537 

- 

c 

538 

RETURN 
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539  -  C 

540  -  140  DO  145  1=3,4 

541  -  145  CALL  RDI SCt L W ( I ) , IQU3,OM( 1, I) , I GNO) 

542  -  C 

543  -  RETURN 

544  -  C 

545  -  150  DO  153  1  =  1,2 

546  -  153  CALL  RU I  SC { L W ( I )  ,  IQU3 ,0M ( 1 , I ) , I GNO) 

547  -  C 

548  -  IF  IISW.EQ.3)  RETURN 

549  -  C 

550  -  DO  158  1=1,2 

551  -  GO  TO  (154,1551 , ISW 

552  -  154  CALL  RDI SC( LW ( I ) , IGUl ,0M ( 1, 1*2 ) , I QNO)  J  GO  TO  158 

553  -  155  CALL  RDI  SCI  LW  ( I +4 ) ,  IQUl ,  0M(  1 ,  !♦•  2)  ,  I QNO) 

554  -  158  CONTINUE 

555  -  C 

556  -  RETURN 

557  -  C 

558  -  160  DO  163  1=1,2 

559  -  163  CALL  RD I  SC ( LW ( 1) , I QU4 ,0M( 1 , IJ , I QNO-NP I E CES ) 

560  -  C 

561  -  IF  (ISW.NE.3)  RETURN 

562  -  C 

563  -  DO  168  1=3,4 

564  -  168  CALL  KD I  SC ( LW ( I  ) , IQU4 ,0M ( 1 , I ) , I QNO-NP lECE S ) 

565  -  C 

566  -  RETURN 

557  _ 

5  68  -  C ♦♦♦♦♦♦♦♦*♦♦*♦**♦♦♦♦♦*♦♦*♦♦*♦**♦****♦♦*♦♦*♦*********** ****^** ** 

569  -  SUBROUTINE  RASTER 

570  -  C  INTERNAL  SUBROUTINE  FOR  PROGRAM  BIVECOI  TD 

571  -  C  DETERMINE  1ST, LAST  SUM  FREQ'S  FOR  THIS  RASTER 

572  -  GO  TO  (10,20,30,40,50,20,30,80,90,100,110,120,100,30, 

573  -  S20,20),ISQ 

574  -  10  IF  (KPASS.EQ.l)  GO  TO  15 

575  -  IFIRST=3  ;  ILAST=LPQU-1  ;  RETURN 

576  -  15  IFIRST=2  ;  ILAST=LPQU  ;  RETURN 

577  -  20  IFIRST=1  ;  ILAST=LPATHE-1  ;  RETURN 

578  -  30  IFIRST=1  ;  ILAST=LPQU-1  ;  RETURN 

579  -  40  IFIRST=LPATHE«-2  ;  ILAST=LP38  ;  RETURN 

580  -  50  IF  (KPASS.EQ.l)  GO  TO  55 

581  -  IFIRST=LPQUf3  ;  I LAST=L PHALF-1  ;  RETURN 

582  -  55  IFIRST=LPQU«-2  ;  ILAST=LPHALF  ;  RETURN 

583  -  80  IFlRST  =  LP38<-2  ;  ILAST=LPHALF  ;  RETURN 

584  -  90  IF IRST=LPQUf2  ;  ILAST=LPHALF  ;  RETURN 

585  -  100  IFIRSr=LPATHE+l  ;  ILAST=LP38-1  ;  RETURN 

586  -  110  IF1RST=LPQU+1  ;  I LAST=LPHALF-1  ;  RETURN 

587  -  120  IFIRST=LP38<-2  *,  ILAST=LPHALF  ;  RETURN 

588  -  C************^*******************************^* 

589  -  c ♦*♦♦♦♦♦*♦♦♦*♦ ♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦*♦♦♦♦*♦♦♦♦♦*♦♦♦♦♦♦♦**♦**♦ 

590  -  SUBROUTINE  READW3 

591  -  C  INTERNAL  SUBROUTINE  FOR  PROGRAM  BIVECOI  TC  FILL 

592  -  C  BUFFERS  W31,W32  FROM  CORE  OR  DISC  APPROPRIATELY 

593  -  NRD=2*NPIECES 

594  -  GO  TO  (10,20,30,40,50,60,70,500,90,100,110,120,130,500, 

595  -  $60,60) , I SQ 

596  -  10  IF  (NCPT .LE.LPATHE)  GO  TD  20 

597  -  IF  (ISW.EQ.l)  K0L=3  ;  MA=2  ;  GO  TO  300 

598  -  IF  ((  ISW.NE.2).0R.(NCPT.NE.LPATHE*-1))  GO  TO  15 
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599  -  C 

600  - 
601  - 

602  -  C 

603  - 
60A  - 

605  - 

606  - 

607  - 

608  - 

609  - 

610  - 
611  - 
612  - 

613  - 

614  - 

615  - 

616  - 
617  - 
618- 

619  - 

620  - 
621  - 

622  -  C 

623  - 

624  - 

625  - 

626  -  C 

627  -  C 

628  - 

629  - 

630  - 
63  1  - 
632  - 
63  3  -  C 

634  - 

635  - 

636  - 

637  - 

638  - 

639  - 

640  - 

641  - 

642  - 

643  - 

644  - 

645  - 

646  - 

647  - 

648  - 

649  - 

650  - 

651  - 

652  - 

653  - 

654  - 

655  - 

656  - 
65  7  - 
658  -  C 


DO  12  I=lt2 

12  CALL  RDISC{LW(H-4),  IQU2,0M(  1,I^2),IQN0) 

15  IF  (ISW.NE.2)  GO  TO  18 
K0L=3  ;  MA=2  ;  GO  TO  300 
18  GO  TO  500 
20  CONTINUE 

IF  nSW.EQ.l)  K0L=1  ;  MA=1  ;  GO  TO  300 

IF  {(  ISW.EQ.2).0R.(LW31.EQ.LW2in  K0L=3  ;  MA=1  ;G0  TO  3  00 
K0L=1  ;  MA=1  ;GG  TO  300 
30  IF  (ISW.EQ.2)  GO  TO  500 

IF  (NCPT.GT.LPATHE)  GO  TO  35 

IF  ({ ISW.EQ.1).0R.(LW31.EQ.LW21))  K0L=3  ;  MA=1  ;Ga  TO  300 
GO  TO  500 
35  CONTINUE 

IF  {(  ISv<.EQ.n.0R.(LW31.EQ.LWll))  K0L=1  ;  MA=2  ;G0  TO  300 
GO  TO  500 

40  IF  (( ISN.EQ.2).0R.INCPT.GT.LPQU))  GO  TO  500 

IF  II  ISN.EQ.l».0R.(LW31.Eg.LWlin  K0L=1  ;  MA=2  ;  GO  TO  300 
GO  TO  500 

50  IF(ISrt.EQ.3)  GO  TO  500 

IF  (NCPT  .NE.LP38*-!)  GO  TO  58 

DO  51  1=1, ISOM 
W21(I)=0. 

51  W22(n=0. 


DO  56  1=1,2 
GO  TO  152,54) , I SW 

52  CALL  RDISCILWII ), IQU4,0M( 1, 162) tlQNO-NPIECES)  ;  GO  TO  56 
54  CALL  RDISC(LW(I*-4),  IQU4,0M(  1,  H-2)  ,IQNO-NPIECES) 

56  CONTINUE 

58  CONTINUE 

IF  (NCPT  .LE.LP38)  K0L  =  3  ;  MA=3  ;  GO  TO  300 
K0L=3  ;  MA=4  ;  GO  TO  300 
60  IF  (ISW.EQ.3)  GO  TO  500 
K0L=3  ;  MA=1  ;  GO  TO  300 

70  IF  ((  ISW.EQ.2). OR. (NCPT. LE.LPATHE))  GO  TO  500 

IF  ((  ISW.EQ.l ).0R.(LW31.EQ.LW21 ) )  K0L=3  ;  MA=2  ;G0  TO  300 
GO  TO  500 

90  IF  (( ISW.EQ.2 ). OR. I NCPT .GT.LP38) )  GO  TO  500 

IF  ((ISW.EQ.l). OR. (LW31.EQ.LW11))  K0L=1  ;  MA=3;G0  TO  300 

GO  TO  500 

100  IF  ((  ISW.EQ.2 ). OR. ( NCPT .LE.LPGU ) )  GO  TO  500 

IF  ((  ISW.EQ.l ) .OR. ( LW31 . EQ. LWll  )  )  K0L  =  1  ;  MA=3  ;GC  TO  300 
GO  TO  500 

110  IF  (I ISW.EQ.2 ). OR. (NCPT. LE.LP38  )  )  GO  TO  500 

IF  ((  ISW.EQ.l ). UR. (LW31.EQ. LWll  )  )  K0L  =  1  ;  MA=4  ;G0  TO  300 
GO  TO  500 
120  CONTINUE 

IF  ((  ISW.EQ.l ). OR. (LW31.EQ. LWll  )  )  K0L  =  1  ;  MA=4  ;  GO  TO  300 
GO  TO  500 

130  IF  ((  ISW.EQ.2). OR. (NCPT. GT.LPQU))  GO  TO  500 

IF  (( ISW.EQ.l ). OR. (LW31.EQ.LW21))  K0L=3  ;  MA=2  ;G0  TO  300 
GO  TO  500 

300  L0C=l4-NRD*{NCPT-(MA-l)*LPATHE-l  ) 


190 

659 

- 

C 

660 

DO  350  I=1,NRD 

661 

- 

Will  I )=0HIL0C*I-1 ,KOL) 

w 

662 

- 

350 

W32(I)=aM(L0C*I-l,K0L6l ) 

hb  3 

- 

c 

664 

- 

c 

665 

- 

RETURN 

66  6 

- 

500 

KREL=IDATSTART6NPIECES*(2*NCPT-1) 

66  7 

-- 

CALL  ROISCILM31,KREL,W31,NRD) 

66  8 

- 

CALL  RDISC(LW32,KREL,W32,NRD> 

669 

— 

RETURN 

670 

* 

671 

672 

— 

SUBROUTINE  FREQINIT  1 

673 

— 

C 

INTERNAL  SUBROUTINE  FOR  PROGRAM  BIVECOl  TO  INITIALIZE  1 

bl^ 

- 

C 

FREQUENCIES  IFltIF2  FOR  A  GIVEN  SCAN.  1 

675 

- 

GO  TO  110,20,30,40,10,60,70,80,90,100,110,120,130,140,  1 

676 

- 

$150,160) ,ISQ  1 

677 

10 

IF  (KPASS.EQ.l)  GO  TO  15 

678 

- 

IFl=NCPT/2*-l  ;  IF2=NCPT/2 

679 

- 

IF  (M0D(NCPT,2) .EQ.O)  IF2=NCPT/2-l 

68  C 

- 

RETURN 

681 

— 

15 

IFl=NCPT/2  ;  IF2=NCPT/2 

682 

- 

IF  (M0DINCPT,2) .EQ. 1)  IF1=IF1+1 

68  3 

- 

RETURN 

684 

- 

20 

IF2=-1 

685 

25 

IF1=-IF2*-NCPT  ;  RETURN 

686 

30 

IF1C=LPATHE<-1  ;  IF2C=-1  ;  IDIAG=LPATH£ 

687 

35 

CONTINUE 

688 

- 

IF  (NCPT.LE.IDI  AG)  IF1=IFIC  ;  I  F2=-IFH-NCPT  ;  RETURN 

689 

— 

IFl=-IF2CfNCPT  ;  IF2=IF2C  ;  RETURN 

690 

40 

IF1C=LPATHEH  ;  IF2C=LPATHE  *,  IDI  AG=LPQU<-1  ;  GO  TO  35 

691 

60 

IF2=-LPATHE-1  ;  GO  TO  25 

692 

70 

IF1C=LPQU*-1  ;  IF2C=-LPATHE-1  ;  I0IAG=LPATHE  ;  GU  TO  35 

693 

- 

80 

IF1=LPQU«- 1 

694 

— 

85 

IF2=-IF1*-NCPT  ;  RETURN 

695 

- 

90 

IF1C=LPQU«-1  ;  IF2C=LPATHE  ;  IDIAG=LP38>1  ;  GO  TO  35 

696 

— 

100 

IFlC=LPaU«-l  ;  IF2C=-1  ;  IDIAG=LPQU  ;  GO  TO  35 

697 

— 

no 

IF1C=LP38>1  ;  IF2C=-1  ;  IDIAG=LP38  ;  GO  TO  35 

698 

- 

120 

IF1=LP38<-1  ;  GO  TO  85 

699 

— 

130 

IF1C=LP38*-1  ;  IF2C=-LPATHE-1  ;  IDIAG=LPQU  *,  GO  TO  35 

700 

140 

IF1C=LP38*^1  ;  IF2C=-LPQU-1  ;  IDIAG=LPATHE  ;  GO  TO  35 

701 

150 

IF2=-LPQU-1  ;  GO  TO  25 

702 

- 

160 

IF2=-LP38-1  ;  GO  TO  25 

703 

— 

704 

705 

SUBROUTINE  BOUNDARY  1 

70  6 

- 

C 

INTERNAL  SUBROUTINE  FOR  PROGRAM  BIVECOl  1 

707 

- 

C 

TO  TEST  FOR  END  OF  SCAN  1 

708 

- 

IBDY=0  1 

709 

- 

GU  TO  (10,20,30,40,50,60,70,80,90,100,110,120,130,140,  1 

710 

- 

$150,160) ,ISQ  1 

711 

- 

10 

IDIAG=LPATHE  ;  IM1=LPATHE  ;  IM2=1  ;  GO  TO  500 

712 

20 

IMl^LPATHE  ;  GO  TO  300 

w 

713 

- 

30 

IDIAG=LPATHE  ;  IM1=LPQU  ;  IM2=-LPATHE  ;  GO  TO  500 

714 

40 

IDIAG=LPQU  ;  IM1=LPQU  ;  IM2=l  ;  GO  TO  500 

715 

- 

50 

IDIAG=LP38  ;  IM1=LPQU  ;  I  M2=LPA  THE*- 1  ;  GO  TO  500 

716 

- 

60 

IM1=LPQU  ;  GO  TO  300 

71  7 

- 

70 

IDIAG=LPATHE  ;  IM1=LP38  ;  IM2=-LPQU  ;  GO  TO  500 

718 

80 

IOIAG=LPHALF  ;  I M2=  LPAT HE«-1  ;  GO  TO  500 
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719  -  90  IDIAG=LP38  ;  IM1=LP38  ;  IM2=1  ;  GO  TO  500 

720  -  100  IDIAG=LPQU  ;  IM1=LP38  ;  IM2=-LPATHE  ;  GO  TO  500 

72  1  -  110  IQIAG=LP38  *,  IM1=LPHALF  ;  IM2=-LPATHE  ;  GO  TO  500 

722  -  120  IOIAG=LPHALF  ;  IM2=1  ;  GO  TO  500 

723  -  130  IOIAG=LPQU  ;  IM1=LPHALF  ;  IM2=-LPQU  ;  GO  TO  500 

724  -  140  IDIAG=LPATHE  ;  IMl=LPHALF  ;  IM2=-LP38  ;  GO  TO  500 

725  -  150  IM1=LP38  ;  GO  TO  300 

726  -  160  IM1=LPHALF  ;  GO  TO  300 

727  -  C 

728  -  300  IF  (IFl.GT.IMl)  IBDY=1 

729  -  RETURN 

730  -  500  IF  (NCPT.GT.IDIAG)  GO  TO  550 

731  -  IF  (IF2.lt. IM2)  I8DY=1 

732  -  RETURN 

733  -  550  IF  (IFl.GT.IMl)  IBDY=1 

734  -  RETURN 

73  5  _  Q^^,^^^^^:^:^**********************************^************^*  ****** 

73  6  -  C  *♦♦♦♦♦♦♦*♦*♦♦  + 

737  -  SUBROUTINE  CBI N ( 8 IC OH, I  PASS ) 

738  -  C  INTERNAL  SUBROUTINE  FOR  PROGRAM  8ISCAL03  10  DETERMINE 

739  -  C  CONFIDENCE  LIMITS  FOR  BICOHERENCES 

740  -  C  HAS  ENTRY  POINTS  CBIN  TO  PLACE  GIVEN  BICOHERENCE  IN 

741  -  C  BIN  AND  CONFIDENCE  TO  INITIATE  CONFIDENCE  LIMIT  CALCULATION 

742  -  IF  (BICOH.LE.RBICLI M)  GO  TO  lOQ 

743  -  KOVER=KOVERfl 

744-  IF  (IPASS.EQ.l)  WRITE  (108,1000)  1 F 1 , I F2 , I F3, B ICOH 

745  -  IF  (IPASS.EQ.2)  WRITE  (  108,  1000)  -I  FI , - 1 F2,- 1 F3 , B ICOH 

746  -  1000  FORMATCROT  BICOH  LIM  EXCEEDED  AT  FREti  TRIPLET  SOI  13, X), 

747  -  $'  WITH  VALUE  SGll.S) 

748  -  IF  (IHI.NE.O)  MTOT  =  MTOTH 

74  9  -  RETURN 

750  -  C 

751  -  100  CONTINUE 

752  -  NIB=INT(  BIC0H/BINSIZE)<-1 

753  -  IF  (NIB.GT.NBINS)  GO  TO  250 

754-  K8IN(NI8)=KBIN(NIB) +1 

755  -  MT0T=MT0T<-1 

756  -  RETURN 

757  -  C 

758  -  250  CONTINUE 

759  -  IF  (IPASS.EQ.l)  WRITE  (  108,  1025)  81  COH,  I  F 1 ,  IF2,  IF3 

760  -  IF  (IPASS.EQ.2)  WRITE  (  108,  1025)  BI COH, -I  FI ,- 1 F2 ,-I F3 

761  -  1025  FORMAT  ('ROT  BICOH  OF  •,F6.2,*  AT  FREQ  TRIPLET  •,3(13,X), 

762  -  $'  MET  NEITHER  BIN  NOR  LIM  CRITERIA*) 

763  -  MTOT=MTOTfI 

764  -  RETURN 

765  -  C 

766  -  C ♦*♦♦♦♦♦♦♦♦*♦♦ ********************************************** 

767  -  ENTRY  CONFIDENCE 

768  -  C ♦*♦♦♦♦*♦♦♦*♦*♦♦♦♦♦♦♦♦***♦♦♦**♦♦♦*****♦***♦**♦♦***♦** *♦*♦**♦* 

769  -  C  OPTIONAL  DISPLAY  OF  PARTITIONING  OF  BICOHERENCES 

770  -  IF  (KBi.EQ.O)  GO  TO  320 

771  -  WRITE  (108,1050) 

772  -  1050  FORMAT  (/,T2,*BIN  N0*,T14,*BIN  LIMITS', 134, 

773  -  $*N0  OF  ROT  BIC'S',/) 

774  -  C 

775  -  C 

776  -  DO  300  I=l,NBINS 

777  -  WRITE  (108,1100)  I ,  ( I-l ) *81 N S I ZE , I*B I NS  I ZE , KB  I N ( I ) 

778  -  1100  FORMAT  ( T3 , 1  3 , T1 3, 2 ( F4. 2  ,4X ) ,T 34, I  5 ) 


779  - 

780  - 

781  - 

782  - 

783  - 

784  - 

785  - 

786  - 

787  - 

788  - 

789  - 

790  - 

791  - 

792  - 

793  - 

794  - 

795  - 
79  6  - 

797  - 

798  - 

799  - 

800  - 
801  - 
eo2  - 

803  - 
P04  - 

805  - 

806  - 

807  - 

808  - 

809  - 

810  - 
811  - 
812  - 
813  - 
P  14  - 

815  - 

816  - 

817  - 

818  - 

819  - 

820  - 
821  - 
822  - 

823  - 

824  - 

825  - 

826  - 

827  - 

828  - 

829  - 

830  - 

831  - 

832  - 

833  - 

834  - 

835  - 

836  - 

837  - 

838  - 
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300  CONTINUE 
C 
C 

320  CONTINUE 

C  CONVERT  NO  OF  ROT  BIC'S  IN  KBIN  TO  TOTAL  FRACTION 
C  AT  INDEX  VALUE 

KSUBTor=o  ;  i=o 
WRITE  (108,1125)  MTOT 

1125  FORMAT  (/, 'TOTAL  NO  GF  ROT  BIC'S  SUBMITTED:  *,15,/) 
FTOT=FLOATCMTOT ) 

C 

340  CONTINUE 
1  =  1+1 

IF  (I.GT.NBINS)  GO  TO  350 
C 

KSU6T0T  =  KSUBT0T  fKBINi  I ) 

ABINl I)=FL0AT(KSUBT0T) 

ABIN( I )=ABIN( I )/FTOT 
GO  TO  340 
C 

350  CONTINUE 

C  OPTIONAL  DISPLAY  OF  PARTIAL  SUMS  AT  INDEX  VALUE 
IF  (KBZ.EQ.O)  GO  TO  400 
WRITE  (108,  1150) 

1150  FORMAT  ( / ,T32 , ' FR ACT  BELOW* ,/ ,T2, 'B IN  N0',T14, 

$'BIN  LIMITS', T31, 'UPPER  BIN  LIM',/) 

C 

C 

DO  380  I=1,NBINS 

WRITE  (108,1200)  I , ( I -1 ) »8I NS IZ E , (♦BINS  I ZE, AB IN ( 1 ) 

1200  FORMAT  ( T3, 1  3 ,T 13, 2 (F4. 2 ,4X ) , T34, F5.3) 

380  CONTINUE 
C 
C 

400  CONTINUE 
C 
C 

C  COMPUTE  CONFIDENCE  LIMITS 
1=0 
C 

420  CONTINUE 
1  =  1+1 

IF  (I.GT.NCONF)  GO  TO  600 
J=0 
C 

450  CONTINUE 
J  =  J  +  1 

IF  (J.GT.NBINS)  WRITE  (  108,  1250)  CONF  ( I  )  ;  6CL(  11=999. 

$G0  TO  420 

1250  FORMAT  ('BINS  EXHAUSTED  FOR  CONFIDENCE  LEVEL', F6. 3) 

IF  (ABIN( J) .GE.CONF ( I ) )  GO  TO  470 
GO  TO  450 
C 

470  CONTINUE 
C 

JH=J 

JL=J-1 

Yl=JL^bI NSI ZE 
Y2=JH*BINSIZE 
X1=0 


839  - 

840  - 

841  - 

842  - 
8  43  - 

844  - 

845  - 

846  - 
84  7  - 

848  - 

849  - 

850  - 

851  - 

852  - 

853  - 

854  - 
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IF  IJL.NE.O)  X1=ABIN{JL) 

X2=ABiN( JH) 

XO=CQNF{ I » 

BCL(I  )=YH-(X0-X1)*{  Y2-Y1  }/(  X2-X1) 

GO  TO  420 
600  CONTINUE 
C 

C  PRINT  CONFIDENCE  LEVELS 

WRITE  (108,14001  NCONF,  (CONF I  1) *100 . ,BC L ( I )  , I =1 , NCONF ) 
1400  FORMAT  (/ ,T4, • CONF I DENCE T6 LEVEL S T2 1 ROT  ARY  •, 

S 'BICOHERENCE* ,/ ,T5,  ' (PERCENT) ' , / ,N ( T 7 ,F 4. 1 , T24 , F 5 . 3 , / )  ,  / ) 
WRITE  (108,1450)  RS ICLI M, KOVER 
1450  FORMAT  ( • NO.  OF  ROT  BIC**S  GREATER  THAN  SPECIFIED  ', 
S'MAXIMUM  OF  *,85.2,'  IS  *,15,/) 

RETURN 

END 


PROGRAM  BPLOT 
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1  -  C  *****  B  P  L  0  T  ***** 

2  -  C  PROGRAM  TO  PLOT  FILE  OF  BICOHERENCES  WRITTEN  BY 

3  -  C  PROGRAM  8ISCAL 

4  -  C  PROGRAMMER:  GERARD  H.  MARTINEAU 

5  -  C  ORIGINATOR:  MELBOURNE  G.  BRISCOE 

6  -  C  DATE:  JULY,  1977 

7  -  DIMENSION  D AT  A ( 200,  130 J , IBUF ( 1000 ) , CONL V ( 1 5 ) , 

8  -  $KAR0(20)  ,  IDENT1(9>,  I DENT2  (  9  )  ,  IC  LK  ( 4 )  ,LABL  (33)  ,CONFLV  ( lt> )  , 

9  -  $INAMES{9) ,IVAR( 3) 

10  -  MD1=200  ;  MD2=130 

11-  NAMELIST  ISTORE  ,NDeCPL,CMPPT, IHISTORY, WIDTH 

12-  ISTORe=NDECPL=l  ;  CMPPT=-1.  ;  WIDTH=8.75 

13  -  IHIST0RY=1 

14  -  INPUT 

15  -  READ  (105,1111)  KARD 

16  -  1111  FORMAT  (20A4) 

17  -  WRITE  (108,1122)  KARD 

18  -  1122  FORMAT  (X,20A4) 

19-  DECODE  (80,3333  , KARO)  NSERI ES , LP I ECE 

20  -  3333  FORMAT  (2G) 

21  -  LPHALF=LP  IECE/2  ;  NFHALF=LPHALF/2 

22  -  IF  (CMPPT.LT.O)  CMPPT=W IDTH+2.54/LPHALF 

23  -  READ  (105,1111)  KARO 

24-  WRITE  (108,1122)  KARD 

25  -  DECODE  ( 80, 2222 , KARD )  S AMPSEC , FREQT I C ,NCONLV , 

26  -  $NC0NLV,(C0NLV(I),I=1,NC0NLV), 

27  -  $NCONLV, (C0NFLV( 1) , I =1,NC0NLV) 

28  -  2222  FORMAT  (3G,NG,NG) 

29  -  READ  (105,1111)  KARD 

30-  WRITE  (108,1122)  KARD 

31  -  DECODE  ( 80,4444 , KARD)  I  DENT  1 , IDENT2 

32  -  4444  FORMAT  (9A4,9A4) 

33  -  C 

34  -  C 

35  -  C  READ  BICOHERENCES  INTO  ARRAY  DATA! 200, 130) 

36  -  C  FIRST  SET  ARRAY  DATA  TO  -999. 

37  -  C 

38  -  C 

39  -  C  OUTPUT  M02,MD1, NFHALF,LPHALF 

40  -  DO  50  J=1,MD2 

41  -  C 

42  -  DO  50  1  =  1, MDl 

43  -  50  DATA! I , J )=-999. 

44  -  C 

45  -  C  OUTPUT  NSERIES,LPHALF,NFHALF, ISTORE 

46  -  C 

47  -  IF  (NSERIES.EQ.l)  GO  TO  60 

48-  READ  (ISTORE)  {  (0  AT  A  (  I ,  J  )  ,  I  =LPH  ALF  <-2  ,  LPHALF  ^-NFHAL  F  1 )  , 

49  -  $J=1,NFHALF) 

50  -  C  OUTPUT  'Bll* 

51-  READ  (ISTORE)  (  (D AT  A ( I , J ) , I =NFH ALF* 1 , LP HALF ) , J= 1 , NF HALF ) 

52  -  C  OUTPUT  'B22' 

53-  READ  (ISTORE)  (  ( D  AT  A  (  I  ,  J  )  ,  I  =  LPH  ALF  <-2,  LP  HALF  «-NFHALF  1 )  , 

54  -  $J=NFHALF+1,LPHALF) 

55  -  C  OUTPUT  • B33' 

56-  READ  (ISTORE)  ( (DAT  A ( I , J ) , I =NFH ALF* 1 , LPHALF ) , 

57  -  $J=NFHALF+1,LPHALF) 

58  -  C  OUTPUT  • B44' 


59 

60 
61 
62 

63 

64 

65 

66 

67 

68 

69 

70 

71 

72 

73 

74 

75 

76 

7  7 

78 

79 

80 

8  1 
82 

83 

84 

85 

86 

87 

88 

89 

90 

91 

92 

93 

94 

95 

96 

97 

98 

99 
100 
101 
102 

103 

104 

105 

106 

107 

108 

109 

110 
111 
112 

113 

114 

115 

116 

117 

118 
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READ  (ISTORE)  (  (0  AT  A  (  I  ,  J  )  ,  I  =  1 ,  NFHALF)  ,  J=NFH  AL  F«- 1 ,  LP  HALU 
C  OUTPUT  *82' 

GO  TO  80 
60  CONTINUE 
C  OUTPUT  *83' 

READ  (ISTORE)  { (DAT A ( I , J ) 1 1  =  1 tNFHALF ) , J  =  1 , NFHAL F ) 

READ  (ISTORE)  (  CD  AT  A  (  I  ,  J  )  ,  I  =  1  .NFHALF  )  ,  J=NFHAL  F«- 1 ,  LP  HALF  ) 

80  CONTINUE 

IF  (IHISTORY.EQ.OI  GO  TO  85 
C  READ  FOURIER  LABELS 

READ  (ISTORE)  ( INAMES ( I ) , 1= 1 1 3 ) , I  VAR ( 1 ) 

READ  (ISTORE)  ( INAMESI I ) , 1=4,6) , I VAR(2) 

READ  (ISTORE)  ( IN AM ES ( I ) , 1=7 , 9 ) , I VAR ( 3) 

READ  (ISTORE)  MF 
IF  (MF.NE.21)  GO  TO  85 
READ  (ISTORE)  LABL 
85  CONTINUE 
C  DO  90  K=l,ll,10 

C  WRITE  (108,1111)  ((  DATA!  I  ,J  )  ,J=K,K4-9)  ,1=1,30) 

Cllll  FORMAT  (10(X,F6.2)) 

C  90  CONTINUE 
C  OUTPUT  •B4» 

CALL  PLQTSI IBUF,-1000) 

C  OUTPUT  •85* 

CALL  PL0T(0.,0.5,-3) 

C  OUTPUT  •86* 

WRITE  (108,1000)  (CGNLVC I ) , I =1, NCONLV ) 

1000  FORMAT  (/, ’CONTOUR  LE VELS  :’,/,(  IH  ,5G13.3,/)) 

CALL  DIMWH(DATA  ,MD1 ,MD2 ) 

CALL  FLAGZ(-999.0) 

CALL  NOLABL 
DEL=CMPPT/2.54 
AXLEN=LPHALF*DEL 
SAMPHR=SAMPSEC/3600. 

DFT0T  =  1./(2.*SAMPHR) 

DISTIC=AXLEN*FREQTI C/DFTOT 
AYLLEN= ( I  NT lAXL  EN/0 1  ST  I C ) ♦! ) *01  ST IC 
AYHLEN=AXLEN/2.+D.25 
FIRSTV=- (AYLLEN/DISTIC)*FREQTIC 
C  OUTPUT  ’87' 

IF  (NSERIES.EQ.l)  GO  TO  120 
C  X-AXIS  WITH  TIC  MARKS  ONLY,  STARTING  AT  ORIGIN 
C  OUTPUT  AXLEN.AYLLEN, AYHLEN,FREQTIC,DISTIC,NDECPL,FIRSTV 

CALL  AXWJSI AXLEN,AXLEN,*  • ,-l ,AXLEN ,-90 . , 0. , 1 . , D 1ST IC , 

S— 1 ,0,0, • 12, ,7 , aOOOl , *  14) 

C  X-AXIS  STARTING  ABOVE  MAX  Y  VALUE 

C  OUTPUT  • 871* ,AXLEN+AYHLEN,AXLEN,FREQTIC,DISTIC,NOECPL 

CALL  AXDRAW(AXLEN*-AYHLEN,AXLEN, 'FREQl  (CPH)',11, 
$AXLEN,-90.,0. ,FREQT IC,OISTIC,NDECPL ) 

C  X-AXIS  STARTING  BELOW  MIN  Y  VALUE 

C  OUTPUT  • 872’ ,AXLEN-AYLLEN,AXLEN,FREQTIC,OIST IC,NDECPL 

CALL  AXDRAW(AXLEN-AYLLEN,AXLEN, 'FREQl  (CPH)',-11, 
$AXLEN,-90.,0. ,FREQT I C , D 1ST  I C , NO ECPL ) 

C  Y-AXIS  FOR  TWO  SERIES 

C  OUTPUT  •B73',AXLEN-AYLLEN,AXLEN,AYLLEN<-AYHLEN,FIRSTV,DISTIC 

CALL  AXDRAW(AXLEN-AYLLEN,AXLEN, •FREQ2  (CPH)*,ll, 
$AYLLEN*-AYHLEN,0.,FI  RSTV  ,FREQTIC  ,DIST  IC,  NO  EC  PL  ) 

GO  TO  150 
120  CONTINUE 
C  X-AXIS  FOR  ONE  SERIES 


119  - 

120  - 
121  - 
122  - 

123  - 

124  - 

125  - 

126  - 

127  - 

128  - 

129  - 

130  - 

131  - 

132  - 

133  - 
I  34  - 

135  - 

136  - 
13  7  - 

138  - 

139  - 

140  - 

141  - 

142  - 

143  - 

144  - 

145  - 

146  - 

147  - 

148  - 

149  - 

150  - 

151  - 

152  - 
1  53  - 

154  - 

155  - 
]  56  - 

157  - 

158  - 

159  - 

160  - 
161  - 
162  - 

163  - 

164  - 

165  - 

166  - 

167  - 

168  - 

169  - 

170  - 

171  - 

172  - 

173  - 

174  - 

175  - 

176  - 

177  - 

178  - 
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CALL  AXDRAW{0.,AXLEN,*FREQ1  ( CPH) • ,-l It AXLEN,-90. ,U . , 
SFREQT  ICtOISTICtNDECPL) 

C  Y-AXIS  FOR  ONE  SERIES 

CALL  AXORAWIO.t AXLENt*FREQ2  ( CP H ) • t 11 ♦ A YH LE N, 0. ♦ 0. , 

SFREQT  IC.DIST  IC.NDECPLJ 
150  CONTINUE 
C  PLOT  IDENTIFICATION 

IF  (NSERIES.EQ.l)  GO  TO  160 
EXPLOT=AXLEN«-AYHLEN 
GO  TO  165 
160  EXPLOT=AYHLEN 
165  WYEPLOT=AXLEN 

IF  (NSERIES.EQ.U  GO  TO  170 
CALL  S YMBOL ( EXP LOTfT. 0 t WYEPLOT- 1.8, 0.31 5t 
S'CROSS  8IC0HERENCE' ,-90.,17) 

GO  TO  175 

170  CALL  SYHB0L(EXPL0Tf7.0, WYEPLOT-2.0,0.315, 

S'AUTO  BICOHERENCE't-90.,16) 

175  CONTINUE 

IF  ( IHISTORY.EQ.O)  GO  TO  179 

CALL  SYMBOL (EXPLOT+6.5,WYEPLOT-1.6,0.175, 

S'ORIGINAL  FILE  NAME S : ' ,-90. , 20) 

CALL  SYMBOL  (EXPL0T*-6. 5,  WYEPLOT-5.7,0.  17  5, 

S'VARIABLE  NUMBERS :•  ,-90 ., 17 ) 

CALL  SYMB0L(EXPL0T4-6. 2, WYEPLOT-O. 5, 0.14, 'FREQUENCY  1:', 
$-90., 12) 

CALL  SYMB0L(EXPL0T*-5. 9, WYEPLOT-0. 5,0.  14, 'FREQUENCY  2:', 
$-90., 12) 

CALL  SYMB0L(EXPL0Tt5. 6, WYEPLOT-0. 5, 0.14, 'FREQUENCY  3:', 
$-90., 12) 

IF  (MF.NE.21)  GO  TO  177 

CALL  SYMBOL  (EXPLOT*- 5.  1,  WYEPLOT-2. 9,0.  17  5, 

$'PROCeSSING  HISTORY', -90. ,18) 

177  CONTINUE 

CALL  SYMBOL  (EXPL0T»-6.2,WYEPL0T-2.5,0.14,INAMLS,-90.  ,12) 
CALL  SYMB0L(EXPL0T*>5.9,WYEPLaT-2.5,.14,  I  NAMES  1 4  ),-9  0.,i2) 
CALL  SYMB0L(EXPL0T«-5.6,WYEPL0T-2.5,.14,  INAMES(7  )  ,-90.  ,12) 
FVAR=FL0AT(IVAR(1)) 

CALL  NUMBER{EXPL0T>6.2, WYEPLOT-7. 1,0. 14 ,F VAR,-90. ,- 1 ) 
FVAR=FLQATC IVAR(2 ) ) 

CALL  NUMBERlEXPLOTf 5.9, WYEPLOT-7. 1,0. 14 ,F VAR,-90. ,-l ) 
FVAR=FLOAT( IVAR(3)) 

CALL  NUMBER(EXPL0T<-5.6,  WYEPLOT-7.  l,0.14,FVAR,-90.,-l) 

IF  IMF.NE.21)  GO  TO  179 

CALL  SYMBOL{EXPLOT+4.8,WYEPLOT-0.7,0.105,LABL,-90., 72) 
CALL  SYMBOL  (EXPL0T'-4.5,  WYEPLOT- 1.3,  .105  ,LA8L(  19  )  ,-90.  ,bU) 
179  CONTINUE 

CALL  SYMBOL  (EXP  LOT'- 1.1 5,  WYE  PLOT-1. 0,0. 210 , 1  LENT  1,-90.  ,36) 
CALL  SYMBOL  ( EXPLOTi-O.  85  ,  WYE  PLOT -1  .0 ,0.210  ,  I  LENT  2  ,-9  0.  ,3  b) 
CALL  TODAY!  ICLK ) 

CALL  SYMBQL(EXPL0T'-3.0,  WYEPLOT-0.6,0.175,  'T  IME  OF  PLOT:', 
$-90., 13) 

CALL  SYMBOL  (EXP  LOT*- 2. 7,  WYEPLOT-0. 3, 0.  17  5,  ICLK, -90.  ,  16  ) 
CALL  SYMBOL  (EXPLOT*-3.8,  WYEPLOT-3.8, 0.  14  0, 

$'CONTQUR  LEVELS  AND  PERCENT  CON  FI DENCE » , -90 . , 37 ) 

BI ASX=BIASY=0. 

C 

C 

IF  (NCONLV.GT.IO)  NC0NLV=10 
DO  185  I  =  1,NC0NLV 
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179 

180 
181 
182 

183 

184 

185 
1  86 

187 

188 

189 

190 

191 

192 

193 

194 

195 

196 

197 

198 

199 

200 
201 
202 

203 

204 

205 

206 

207 

208 

209 

210 
211 
212 

213 

214 

215 

216 
217 


IF  (I.tQ.6)  BIASX=0.  ;  8IASY=BIASY-3.0 

CALL  NUMBER  ( EXPL0T+-3 .3*-BI  ASX  ♦  HYEPLQT-4.  0+BI  ASY»  0.21  0# 
SCONLVt I ) ,-90. ,3) 

CALL  NUMBER  CEXPLOT*-3  .3*- BI  ASX,  WYEPLOT-5. 4+BI  ASY,  0. 21  0, 
$C0NFLV(  nf-90.,l) 

BIASX=BI ASX-0.4 
185  CONTINUE 
C 
C 

C  DRAW  BOUNDARIES 

CALL  PLOT (0., 0. ,3) 

C  OUTPUT  '88’ 

IF  (NSERIES.EQ. 1»  GO  TO  200 
CALL  PLOT (AXLEN,AXLEN,2 ) 

CALL  PLOTa.5*AXLEN,AXLEN/2.,2) 

CALL  PL0TIAXL£N,0.,2) 

CALL  PL0T(0.,0.,2) 

GO  TO  20  5 
200  CONTINUE 

CALL  PLQTIO., AXLEN,3) 

CALL  PL0r(AXLEN/2., AXLEN/2. ,2) 

CALL  PLOT(0.,0. ,2) 

205  CONTINUE 

C  CALLS  TO  SYMBOL  AND  NUMBER 
GO  TO  (210,220) ,NSERIES 
210  CALL  GRID(DEL,AXLEN-DEL,DEL,-DEL) 

C  OUTPUT  JEL, NFHALF,LPHALF, ‘ONE* 

CALL  WHCNTRIDAT  A, 1 , NFHA LF, 1 , L PH ALF , NCONLV ,CONLV ) 

CALL  PLOT  10. ,0.  ,3) 

CALL  PL0T(1.5*AXLEN,-0.5,999) 

GO  TO  250 

220  CALL  GRI 0(0., AXLEN-CEL,DEL,-DEL ) 

C  OUTPUT  JEL,NFHALF,LPHALF, 'TWO* 

CALL  WHCNTR  (DAT  A,  1,  LPHALF+NFHALF*-!,  1 ,  LPH  A  LF  ,  NCONLV,  CONL  V  ) 
CALL  PLOT (0. ,0. ,3 ) 

CALL  PL0T(2.5*AXLEN,-0.5,999) 

250  CONTINUE 

STOP  'NORMAL  PROGRAM  COMPLETION' 

END 
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PROGRAM  FOURIER 


200 


1 

2 

3 

4 

5 

6 

7 

8 
9 

10 

11 

12 

13 

14 

15 

16 
17 
1  8 

19 

20 
21 
22 

23 

24 

25 

26 

27 

28 

29 

30 

31 

32 

33 

34 

35 

36 

37 

38 

39 

40 

41 

42 

43 

44 
4  5 
4  6 
47 
4  8 

49 

50 

51 

52 

53 

54 

55 

56 

57 

58 


C  «<  FOURIER  >;►> 

C  PROGRAM  TO  CREATE  RHDISC  FILE  OF  FOURIER  CO  EFFI C I  E^JT  S 
C  FROM  RWUISC  FILE  OF  SERIES 

C  INPUT  FILE  HAS  21  LOGICAL  FILES,  THE  LAST  BEING 
C  IMAGE  OF  ORIGINAL  TAPDIS  FILE. 

C  PROGRAMMER:  G.  MARTINEAU  VERSION  02  1/12/78 
COMMON  kJKI33000), 

$AMEANU50),MPT(  15  0)  ,  KPT  (150  )  ,NSSMP(2)  , 

$ICLK(4) , LABL(33), 10 VERL AP , I HANN , 

$ND02,NPI N,NDIM, IPREW,ISUBSAMP,NPIECES,LPIECE, 
$R2,ERRY,ERRA0,£RRA1  ,  I S  I  GN  ,  I  T  APE  R,  MF  FT  , 

$NF1LES,I  SU8T,MF,IFIRST,  HAST 
DIMENSION  X(450) ,Y( 450) 

EQUIVALENCE  ( NSSMPI 1 ) ,NSUBS AMP) 

CALL  CTRL 
X  OUTPUT  'FI' 

CALL  OPAR(NERR,MF ,1 ,1 ,KSUM, 512) 

C 

C 

DO  500  LF=IFIRST, IL AST 

X  OUTPUT  '£2' 

CALL  INPUT(LF) 

X  OUTPUT  'FB' 

CALL  KOEFF{X,Y,LPieCE) 

X  OUTPUT  • F4' 

CALL  OUTOMEGA(LF) 

X  OUTPUT  'FS' 

500  CONTINUE 
C 
C 

CALL  TOOAYI ICLK ) 

CALL  LABEL 
X  OUTPUT  'FB* 

CALL  CDISC 

STOP  'PROCESSING  COMPLETED' 

C 

C 

SUBROUTINE  LABEL 

C  INTERNAL  SUBROUTINE  FOR  PROGRAM  FOURIER  TC  CREATE 
C  LABEL  AND  OUTPUT  TO  LOG.  FILE  21  AND  WRITE 
C  ON  LINE  PRINTER 

NDATL=NP IECES*LPI£CE 
NFILES=ILAST-IFIRST«-1 

ENCODE  (  132, 1000, LABL.NOCH)  NFI LES , NPIN, I PREW , I  SUBS  AMP, 
tNSUBSAMP ,LPIECE,NPI ECES , I  OVERLAP, ISUBT,  I HANN, ICLK 
1000  FORMAT  I  '  NO  LF"S  ',12, '♦NO  WDS  DATA  ',15, '♦PREW  ',11, 

$'+SU8SAMP  ' ,11, •♦NSUBSAMP  ',13, '♦PC  SIZE  ',15, '♦NO  PCS  ', 
$I3,'*0LAP  ',11, •♦ISUBT  ',11, •♦HANN  ',11,'  ♦CREATED  ’,444) 
IF  {MF.NE.21)  GO  TO  150 
C  WRITE  L.F.  21  ON  DISC 

CALL  WDI SCI  21 ,1 ,LA8L  ,33 ) 

150  CONTINUE 

C  WRITE  LABEL  TO  LINE  PRINTER 
WRITE! 108,2000)  LABL 

2000  FORMAT  1/ , 'LABEL  AS  WRITTEN  ON  L.F.  21  IF  MF  =  21;', 

$/,lH  ,33A4,/) 

RETURN 

END 
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59 

60 
61 
6? 

63 

64 

65 

66 

67 

68 

69 

70 

71 

72 

73 

74 

75 

76 

77 

78 

79 

80 
81 
82 

83 

84 

85 

86 

87 

88 

89 

90 
9  1 

92 

93 

94 

95 

96 

97 

98 

99 
100 
101 
102 

103 

104 

105 

106 

107 

108 

109 

110 
111 
112 

113 

114 

115 

116 

117 

118 


C ♦♦♦♦♦♦♦♦♦♦♦♦♦ ♦♦♦♦♦♦♦♦♦♦♦*♦♦♦♦♦♦♦♦♦♦*♦♦♦♦*♦♦♦*♦*♦**♦♦* ♦♦*♦*♦*♦♦ 

SUBROUTINE  L I NREG (NPTSt X, Y t AO , A 1, R2 , ERR Y , ERRAO, ERRAl ) 

Q  ♦♦♦♦♦♦♦♦♦♦♦♦*♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦*♦<= 

C 

C  LINEAR  REGRESSION  OF  Y  ON  X 

C 

DOUBLE  PRECISION  SX ♦ SYi SX2, SY2, SXY, SXX» SYYi A0,A1 
DIMENSION  X( 1) ♦¥( 1) tTEMPI450» 

C  CALCULATE  SUMS  OF  SQUARES,  ETC. 

CALL  SUMM(NPTS,X,SX ) 

CALL  SUMMINPTStY,  SY  ) 

DO  10  I=1,NPTS 
10  TEMP(n=XU  )4X(  I  ) 

CALL  SUMMCNPTS.TEMP ,SX2  ) 

DO  20  I=1,NPTS 
20  TEMPI  I )=Y( I )*YI I ) 

CALL  SUMM(NPTS,TEMP  ,SY2  ) 

DO  30  I=1,NPTS 
30  TEMPI  II=Xin*Y(  I) 

CALL  SUMMINPTS, TEMP, SXY ) 

SXX=SX2-SX*SX/NPTS 

SYY=Sy2-SY*SY/NPTS 

SSXY=SXY-SX4SY/NPTS 

C  CALCULATE  REGRESSION  LINE  Y  =  A0«-A14X 

A1=SSXY/SXX 
A0=SY/NPTS-A1*SX/NPTS 
C  CALCULATE  CORRELATION  COEFFICIENT 

R2=SSXY*SSXY/SXX/SYY 

C  CALCULATE  STANDARD  ERRORS  OF  ESTIMATE 

ERRY=DSQRTl { S Y2-A0* SY-A 1*SX Y ) / I NPTS-2 ) ) 

ERRAO=ERRY*DSQRT{ SX2/NPTS/SXX) 

ERRA1=ERRY/DSQRT{  SXX) 

RETURN 

END 

SUBROUT  I NE  TR ENDR I NPTS , X , AO , A 1 ) 

C 

C  REMOVES  LINEAR  REGRESSION  LINE  FOUND  BY  LINREG 

C 

DOUBLE  PRECISION  AD,A1 
DIMENSION  XU) 

DO  10  1=1, NPTS 
10  X( I )=XI I )-A0-A14I 
RETURN 
END 

Q  ♦♦♦♦♦♦♦♦♦  ♦♦♦4' 4 

Q 

SUBROUTINE  SUMMI N ,X , SUMX ) 

(;  444(44444*444444444444444 

C 

DOUBLE  PRECISION  SUM1,SUMX 
DIMENSION  X(l) 

SUM1=0 
DO  10  1=1, N 
10  SUMl=SUM14XI I > 

SUMX=SUM1 

RETURN 
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119  -  END 

120  -  C ♦♦♦♦*♦♦♦*♦♦♦♦♦♦*♦*♦♦♦♦♦**♦♦♦♦♦*♦♦♦♦♦**♦♦♦******* *****^** *****'*' 

121  -  c 

122  -  SUBROUTINE  CTRL 

123  -  C  FOR  PROGRAM  FOURlERt  TO  INITIALIZE, 

124  -  C  AND  READ  IN  CONTROL  PARAMETERS 

125  -  COMMON  *^KI33000), 

126  -  $AMEAN(150),MPT(150> ,KPTI150),NSSMP(2), 

127  -  $ICLKI4),LABL(33), IOVERLAP,IHANN, 

128  -  $Nl)02,NP1N,NDIM,  IPREW,ISUBSAMP,NPIECES,LPIECe, 

129  -  $R2,ERRY,ERRA0,ERRA1 ,ISIGN,ITAPER,MFFT, 

130  -  $NFILES,ISUBT,MF,IFIRST,  ILAST 

131  -  DIMENSION  KFFT(84) 


DATA  KFFT/ 


133  - 

$ 

12, 

16, 

20, 

24, 

32, 

36, 

40, 

46, 

60,  64, 

134  - 

S 

72, 

80, 

96, 

100, 

108, 

120, 

128, 

144, 

160,  180, 

135  - 

$ 

192, 

200, 

216, 

240, 

256, 

288, 

300  , 

320, 

324,  360, 

136  - 

$ 

384, 

400, 

432, 

480, 

500, 

512, 

540, 

576, 

600,  640, 

137  - 

$ 

648, 

720, 

768, 

800, 

364, 

900, 

960, 

972, 

1000,1024, 

138- 

$ 

1080, 

1152, 

1200, 

1280, 

1296,1 

440, 

1500, 

1536, 

1600,1620, 

139 

140 

141 

142 

143 

144 

145 

146 

147 

148 

149 

150 

151 

152 

153 

154 

155 

156 

157 

158 

159 

160 
161 
162 

163 

164 

165 

166 

167 

168 

169 

170 

171 

172 

173 

174 

175 

176 

177 

178 


S  1728,1800, 1920,1944,2000,2048,2160,2304,2400,2500, 

$  2560,2592,2700,2880,2916,3000,3072,3200,3240,3456, 

$  3600,3840,3888,4000/ 

EQUIVALENCE  ( NSSMPI 1 ) ,NSUBS AMP ) 

IPREW=L SUBSAMP=NSUBSAMP=ISUBT=0 
MF=21 

IOVERLAP=IHANN=l 
NAMELIST  MF 

READ!  105,1000)  IF IR ST, I  LAST ,ND02, IPREW,  I  SUBS AMP, 
SISUBSAMP  ,  (NSSMPI  I  )  ,  1  =  1  ,  I  SUBS  AMP)  ,L  PIECE,  lOVERLAP,  I  SUB!  , 

SIHANN 


-  1000 


GO  TO  200 


90 


-  2000 


STOP 

',14,'  INVALID. MUST 
,/ , {X,25I5) ) 


BE 


FORMAT  (5G,N(G),4G) 

DO  90  1=1,84 

IF  (LPIECE.EQ.KFFT( I ) ) 

CONTINUE 

WRITE  (108,2000)  LPIECE,KFFT  ; 

FORMAT  (‘PIECE  LENGTH  OF 
S'FROM  THE  FOLLOWING  SET:* 

200  CONTINUE 
NPIN=ND02 

IF  (ISUBSAMP.EQ.O )  GO  TO  100 
C  NSUBSAMP  MUST  BE  ODD  FUR  TRIANGULAR  WEIGHTING 

IF(M00(NSUBSAMP,2)  .EQ.  0)  WRITE! 108, 11 11 ) ; 

$OUTPUT  NSU8SAMP;ST0P 

1111  FORMAT (' SUBSAMPLE  LENGTH  MUST  BE  ODD') 

ND02  =  ND02/NSUBSAMP 
CONTINUE 
INPUT 

IF  (( IHANN.EQ.O). AND. ( lOVERLAP. EQ.l ))  I0VERLAP=0  ; 

SQUTPUT  'OVERLAP  POSSIBLE  ONLY  IF  HANN.  lOVERLAP  SET 
IF  ((  lOVERLAP. EQ.O)  .AND.  C  (LPIECE.GT. 4  50  ).  DR. 

$ (LPIECE.lt. ND02/150 )) )  OUTPUT  LPIECE, 

S'PIECE  LENGTH  DOES  NOT  SATISFY  RESTRICTION  FOR  NO  OVERLAP 
$*;  STOP 

IF  (( lOVERLAP.NE.O)  .AND . 1 1 L P I  EC E .GT .450) .OR. 

$ (LPIECE. LT.N002/75)  )  )  OUTPUT  LPIECE, 

S'PIECE  LENGTH  DOES  NOT  SATISFY  RESTRICTION  FOR  OVERLAP'; 
SSTOP 

IF  (MF.GT.21)  OUTPUT  'MF  CANNOT  EXCEED  21'  ;  STOP 
IF  ( I (MF  .LT  .21) .AND. ( ILAST.GT.MF) ).0R. 


100 


TO  O' 
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179 

180 
181 
132 

183 

184 

185 

186 

187 

188 

189 

190 
19  1 

192 

193 

194 

195 

196 

197 

198 

199 

200 
201 
202 

203 

204 

205 

206 

207 

208 

209 

210 
211 
212 

213 

214 

215 

216 

217 

218 

219 

220 
221 
222 

223 

224 

225 

226 

227 

228 

229 

230 

231 

232 

233 

234 

235 

236 

237 

238 


$((MF.£Q.21I.AND.(  ILAST.GT.20n)  WRITE  (108,2222) 
2222  FORMAT  CLAST  LOG.  FILE  CANNOT  EXCEED  MF  OR  20') 
RETURN 
END 

SUBROUTINE  INPUT! LF) 

C  FOR  PROGRAM  FOURIER,  TO  INPUT  AND  PREPARE 
C  AN  RWDISC  LOG.  FILE  FOR  THE  TRANSFORM. 

C  DOES  PREWHir£NING,SAMPL ING  AND  SPLITTING 
C  INTO  PIECES 

COMMON  WK (33000), 

$AMEAN(150),MPT( 15 0) , KPT ( I 50 ) , NS SMP ( 2 ) , 

$ICLK(4)  ,LABL(  33),  (OVERLAP,  IHANN, 

$ND02,NPIN,NDIM, IP REW , I SUBSA MP, N PI ECES , LP I  EC E, 
$R2,ERRY,ERRA0,ERRA1 , ISI GN , I T APER, MFFT , 
$NFILES,ISUBT,MF,IFIRST, ILAST 
EQUIVALENCE  ( NSSMP( 1 ) ,NSUBS AMP ) 

X  OUTPUT  'll* 

C  READ  IN  DATA  FROM  RWDISC  FILE,  STARTING  AFTER  LABELS 
CALL  RDISC(LF,5,WK,NPIN) 

IFdPREW  .EQ.  1)  CALL  PREWHITE 
IFIISUBSAMP  .EQ.  0)  GO  TO  150 
C 
C 

C  DO  TRIANGULAR  WEIGHTING 
C 

DO  100  I=1,ND02 
II  =  H-(  I-1)*NSUBSAMP 
MT  =  NSUBSAMP/24-1 
ASUM  =0. 

C 

DO  80  J=1,NSUBSAMP 

80  ASUM  =  ASUMf(  (MT-ABS(MT-J))/(MT*MT)  )*WK(I  14-J-l) 

C 

WK(I)  =  ASUM 
100  CONTINUE 
C 
C 

150  CONTINUE 
X  OUTPUT  •  12* 

C 

IF  I lOVERLAP.EQ.O)  GO  TO  300 
C 

NDIM  =  2*ND02 
NPIECES  =  2^ND02/LP IECE-1 
C  CALCULATE  LENGTH  OF  TOTAL  PIECE  TO  BE  MOVED 
NMOVE  =  NPIECES/2 
LPHALF  =  LPIECE/2 

IFINMOVE  .EQ.  0)  MP T ( 1 )  =  1;  RETURN 
NMLP  =  NMOVE*LPIECE 
C  FILL  ARRAY  OF  INDICES 
C 
C 

DO  200  1=1, NPIECES 

MPT(I)  =  {l  +  (I/2)*LPIECE)*M0D(I,2)i- 
$(d-(I/2-l)*LPIECEfN002)*M0D{  H-1,2) 

200  CONTINUE 
C 
C 
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239 

240 

241 

242 

243 

244 

245 

246 

247 

248 

249 

250 

251 

252 

253 
?54 

255 

256 

257 

258 

259 

26  G 
261 
262 

263 

264 

265 

266 

267 

268 

269 

270 

271 

272 

27  3 

274 

275 

276 

277 

278 

279 

280 
281 
282 

283 

284 

285 

286 

287 

288 

289 

290 

291 

292 

293 

294 

295 

296 

297 

298 


C  ORGANIZE  ARRAY  WK 

C 

C 

X  OUTPUT  *13* 

DO  250  I=1tNMLP 
WK(NOQ2*-l>  =  WK(LPHALF  HI 
250  CONTINUE 
GO  TO  800 
C 

C  NO  SPLITTING  INTO  PIECES 
300  CONTINUE 
NDIM=ND02 

NPIECES=ND02/LP lECE 
C  FILL  ARRAY  OF  INDICES 

C 

C 

DO  400  I=1,NPIECES 
MPTin=H-(I-l  )*LPIECE 
400  CONTINUE 
C 
C 

800  CONTINUE 
C 

c 

RETURN 

SUBROUTINE  PREWHITE 

C  INTERNAL  SUBROUTINE  FOR  SUBROUTINE  INPUT 
C  TO  PREWHITEN  DATA  SERIES 
C 
C 

X  OUTPUT  *14' 

DO  100  I=1.N002-1 
100  WK(  I  )  =  WKl  I«-1)-WK(  I  ) 

C 

C 

WK(ND02)  =  WK{ND02-1) 

RETURN 

END 

SUBROUTINE  KOE FF (X , Y t L P I  EC E ) 

C  FOR  PROGRAM  FOURIER»  TO  DO  FFT  ON  EACH  PIECE 
C  AND  REPLACE  N  POINTS  OF  PIECE  BY 

C  COEFFICIENTS  AOfAlt . A ( N/ 2 ) » B1 , 8 2t . . • B ( N /2 -1 ) 

C  ALSO  SUBTRACTS  MEAN  OR  LINEAR  TREND,  AND  FILTERS 
COMMON  WK(33000) , 

$AMEANl 150),MPT( 150)  , KPT  1 1 50 ) , NS SMP ( 2 ) , 
$ICLK(4),LABL(33 ), 10 VERL AP , I HANN , 

$ND02,NPIN,NDIM, IPRE W , I SUBS A MP ,N PI ECES , L PCDUM , 
$R2,ERRY,ERRA0,ERRA1 , I S I GN, I T APE R, MFFT , 
$NFILES,ISUBT,MF,I  FIRST,  I  LAST 

X  OUTPUT  ND02,NDIM, IPREW,ISUBSAMP,NPIECES,NFILES,ISUBT 

X  OUTPUT  MFFT,ISIGN,ITAPER 

EQUIVALENCE  (  NSSMPI  1  )  ,NSUBS  AMP  ) 

DIMENSION  X(LPIECE) ,YILPIECE) 

DOUBLE  PRECISION  A0,A1 
X  OUTPUT  LPIECE 

LPHALF  =  LPIECE/2 
C 
C 
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299  -  DO  800  I=lfNPiECES 

300  -  M=MPT(U 

301  -  AMEAN(I)  =  0. 

302  -  C  PULL  PIECE  OUT  OF  WORKING  ARRAY 

303  -  C 

304  -  00  40  J*1,LPIECE 

305  -  XIJ)  =  WKIM+J-1) 

306  -  40  Y(J)  *  J 

307  -  X  WRITE  (iOStllil)  1 1 MPT ( I ) 1 1  X IJ )  t J= 1 1 LP I  EC E » 

308  -  Xllll  FORMAT  {‘DATA  P lECE * . 2X , • PI ECE  NO.  • , 1 2 , lOX , • MPT ( 1) , 

309  -  X  $l5»/f6{lH  f 5G13 .5 f / ) f ( IH  f2G13.5f//)) 

310  -  C 

311  -  DO  80  J=1,LPIECE 

312  -  80  AMEAN(l)  =  AMEANl !»  ♦  XIJ) 

313-  AMEANin  =  AMEAN 11 )  /  LP  I  ECE 

314  -  GO  TO  (400,200,100,85) fISUBT  *  1 

315  -  85  CONTINUE 

316  -  C  SUBTRACT  MEAN  OF  EACH  PIECE 

317  -  C 

318  -  DO  90  J=1,LPIECE 

319  -  90  XIJ)  =  XIJ)  -  AMEANII) 

320  -  C 

321  -  X  OUTPUT  'K2» 

322  -  GO  TO  400 

323  -  100  CONTINUE 

324  -  C  CALCULATE  TREND  BY  LINEAR  REGRESSION 

325  -  C  AND  REMOVE  IT 

326  -  CALL  LINREG(LPIECE,Y,X,A0,A1,R2,ERRY,ERRA0,ERRA1) 

327  -  CALL  TRENDRILPIECE,X,A0,A1) 

32  8  -  GO  TO  400 

329  -  200  CONTINUE 

330  -  C  TREND  REMOVAL  BASED  ON  ENDPOINTS 

331  -  X  OUTPUT  •K3* 

332  -  AA  =  IXI LPIECE)-X II ) )/ILPIECE-l  ) 

333  -  68  =  (LP IECE*XI1)-XILPIECE) )/(LPIECE-l) 

334  -  C 

335  -  DO  300  J=1,LPIECE 

336  -  XIJ)  =  X(J)-AA*J-QB 

337  -  300  CONTINUE 

338  -  C 

339  -  400  CONTINUE 

340  -  C  DO  FOURIER  TRANSFORM 

341  -  X  OUTPUT  •K4',LPIECE 

342  -  INDCTR=1 

343  -  DO  450  J*1,LPIECE 

344  -  450  Y(J)=0. 

345  -  CALL  HARM1(X,Y, INDCTR,LPIECE) 

346  -  C 

347  -  IF  IIHANN.EQ.O)  GO  TO  685 

348  -  C=SQRTI3./3. ) 

349  -  C 

350  -  DO  500  K=1,LPIECE 

351  -  500  XIK)=C*XIK) 

352  -  C 

353  -  550  CONTINUE 

354  -  SAV1*XI1) 

355  -  C 

356  -  DO  650  K=l,LPHALF-l 

357  -  650  XIK)  =  0.5*XIK<-l)-0.25*(X(K)«'XlK+-2)) 

35  8  -  C 
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359 

360 

361 
36  2 
36  3 
364 
36  5 

366 

367 

368 
36  9 

370 

371 

372 

373 

374 

375 

376 

377 

378 

379 

380 

381 

382 

383 

384 

385 

386 

387 

388 
3  89 

390 

391 

392 

393 

394 

395 

396 
39  7 

398 

399 

400 

401 

402 

403 

404 

405 

406 

407 

408 

409 

410 

411 

412 

413 

414 
41  5 

416 

417 
41  8 


DO  655  K=l,LPHALF-l 
655  X(H-LPHALF-K)=X(LPHALF-K) 

C 

Xli)=SAVl 
SAVi=X{LPHALF+2  1 
C 

DO  670  K  =  LPHALF*-2,LPIECE-2 
670  X(K)  =  a.5»X(K+l)-0.2  5*(X(K)*^X(K<-2)) 

C 

DU  675  K=l,LPHALF-3 
675  XILPIECE-K)=X(LPIECE-K-1) 

r 

XILPHALF*2)=SAV1 
685  CONTINUE 

C  RESTORE  PIECE  TO  WORKING  ARRAY 
C 

X  OUTPUr  M 

DO  700  J=1,LPIECE 
700  WKIMfJ-1 I  =  XIJ) 

C 

X  WRITE  (108,2222  )  I , MPT ( I ) , I  X  I J )  , J  =  1 , LP I  EC E ) 

X2222  FORMAT  ( • COEFFI C I EN TS ' , 2X , • P I  EC E  NO.  • , I  2 , lOX , • MPT { I ) =•  , 

X  $I5,/,6(1H  ,5G13.5,/ ) ,(1H  ,2G13.5,//)) 

800  CONTINUE 
C 
C 

RETURN 

END 

£4444c4c  4c44c44:4t44  ♦♦♦  ♦  ♦♦  44 44  *  44  444  44**  44 

SUBROUTINE  OUTOMEGA(LF) 

C  FOR  PROGRAM  FOURIER  TO  OUTPUT  COEFFICIENTS  TO  RWDISC 
C  FILE  IN  ORDER  OF  INCREASING  FREQUENCY  AND 
C  ORDER  A,B  Af  A  GIVEN  FREQUENCY,  I.E.: 

C  A(0),A(l),B(l),...,A(N/2-l) ,B{N/2-l ),A(N/2) 

COMMON  WK(33000), 

SAMEANI 150) ,MPT( 150) ,KPT ( 1 50 ) , NS SMP( 2) , 

$ICLK(4) ,LABL( 33 ), I □ V ERL AP , I HANN , 

$N002,NPI N,NDIM, IPREW, ISUBSAMP,NPIECES,LPI ECE, 
$R2,ERRy,£RRA0,ERRAl , I S I GN, I T APE R, MFFT , 

SNFILES, I SUBT,MF ,I FIRST, (LAST 
EQUIVALENCE  I NSSMP( 1 ) ,NSUBS AMP ) 

DIMENSION  BUF(2048) 

KOEFF1=1;LPHALF=LPIECE/2;KA=0;K8=LPHALF41 ; IAB=-1;M=1 
IF  (NPIECES.EQ. 1)  GO  TO  200 
NCOEFF=2048/NPI ECES 
K0EFF2=NC0EFF 

IF  (NCOEFF.GE.LPIECE)  K0£FF2=LP lECE 
C  FILL  BUF  FROM  KOEFFl  THRU  K0EFF2 
50  CONTINUE 
M=1 

C 

c 

DO  100  I=K0EFF1 ,KaEFF2 
IAB=-I AB 

IF  (I.EQ.2)  IAB=-IAB 
IF  (lAB.EQ.l)  KA=KA4l  ;  KUSE=KA 
IF  (lAB.EQ.-l)  KB=KB4l  ;  KUSE=K8 
X  IF  (KUSE.GT.LPIECE)  STOP  'CHK  LOGIC  0000* 

C 
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419  - 

420  - 

421  - 

422  - 

423  - 

424  - 

425  - 

426  - 
42  7  - 

42  8  - 

429  - 

430  - 

431  - 

432  - 

433  - 

434  - 

43  5  - 
436  - 
43  7  - 

43  8  - 

439  - 

440  - 

44  1  - 


C 

C 

C 

C 


c 

X 


X 


DO  80  J=lf 

NPIECES 

LOC=MPTl J) 

-1 

BUF(M) =WK( 

LOC +KUSE) 

M=M4-1 

80 

CONTINUE 

100 

CONTINUE 

WRITE  TO  DISC 

IWR  =  (K0EI-F1-1  )*NPIECESH 
NWR  =  (KOEFF2-KOEFFl«-l  J*NPIECES 


CALL  WDISCILF 
RETURN  IF  HAVE  WR 
IF  (K0EFF2.EQ 
IF  (KGEFF2.GT 
KOEFF 1=KGEFF2 
KQEFF2=RCEFF2 
IF  IKOEFF2.GE 
GO  TO  50 

150  STOP  'CHK  LOG 
200  RETURN 
END 


,4«-lWR,BUF,NWR) 

ITTEN  LPIECE  COEFFICIENTS 
.LPIECE)  RETURN 


•  LPI  ECE) 

STOP 

n 

fNCOEFF 

.LPIECEI 

KOEFF 

IC  2222* 

•CHK  LOGIC  nil' 

2=LPIEC£ 
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PROGRAM  FRAGTAP 


209 


1 

2 

3 

4 

5 

6 

7 

8 
9 

10 

11 

12 

13 

14 

15 

16 

17 

18 

19 

20 
21 
22 

23 

24 

25 

26 

27 

28 

29 

30 

31 

32 

33 

34 

35 

36 

37 

38 

39 

40 

41 

42 

43 

44 

45 

46 

47 

48 

49 

50 

51 

52 

53 

54 

55 

56 

57 

58 


C  «««<  F  R  A  G  T  A  P  >»»» 

C  PROGRAM  TO  RfcAD  TAPDIS  FILES  AND  CREATE  CCNSECUTIVE  FILES 
C  FOR  LATER  TRANSMITTAL  TO  NQN-TAPDIS  RWOISC  FILE 
C  PROGRAMMER:  G.  MARTINEAU  VERSION  01  3/9/77 

DIMENSION  FILE  118000), I  FILE ( 2500) ,JDCB( 25 ),NSEa(25)  , 
$NVI25) f ILF( 25,4) , JFILES (25) ,NCYC(25) , IFILNAM(3) , 

$1SVAR(4) ,  ILAB(9  ) 

EQUIVALENCE  ( F I L E , I F ILE ) , ( I L AB , I F IL NAH ) , ( IL AB ( 4 ) , INVAR) , 
$(ILA8(5) , ICYCLES) ,( ILA8(6), ISVAR) 

MFILE=7 

CALL  DPAR(NERR,MFILE,1, 1,KSUM) 

WRITE  (108,1000) 

1000  FORMAT  ('INPUT  RECORDS  FOLLOW  (IN  GENERALIZED  FORMAT)*) 
READ  (  105,1500)  NF, NF, ( JDCB ( 1 1 , 1  =  1 ,NF ) , LDCB 
1500  FORMAT  (G,NG,G) 

WRITE  (108,1500)  NF ,NF, ( JDCB( I ) , 1=1 ,NF) ,LDCB 
C 
C 

DO  100  1=1, NF 

READ  (105,2000)  NSE  Q 1 1  )  ,N  V(  I  )  ,N  V  ( I )  ,  ( ILF  (  I ,  K )  ,  K=  1 ,  NV  ( I )  ) 
2000  FORMAT  {2G,NG) 

WRITE  (108,2200)  NSEQ ( I ) ,NV ( I ) , NV ( I ) , ( I LF ( I ,K ) , K=1 , NV (  I  ) ) 
2200  FORMATdH  ,2G,NG) 

100  CONTINUE 
C 
C 

C  CALCULATE  STARTING  LOCATIONS  OF  BLOCKS  IN  TAPDIS  FILE 
JFILES(1)=1 

CALL  RDISCd, 100, NOFILES,!) 

X  OUTPUT  NOFILES 

IF  (NERR.NE.O)  OUTPUT  NERR  ;  STOP  2 

LENGTH=100* NOFILES 

CALL  RDISCI 1, 1,  IFILE, LENGTH) 

X  OUTPUT  LENGTH 

IF  (NERR.NE.O)  OUTPUT  NERR  ;  STOP  3 
C 
C 

DO  180  1=1, NOFILES 
180  NCYCI  I  )  =  1FILE  (lOO^l  I-ld-9) 

C 

DO  200  I=2,N0F1LES 

200  JFILESI I  )=JFILES(  I- 1 )  ♦■  I  F I  LE  (  100*  (  1-2  )  *9  ) 

C 

C 

WRITE  (108,2500)  ( I  ,  JF I LES (  I  )  ,  I =1 , NOF IL E S  ) 

2500  FORMAT  ( / ,T4 , • SEQUE NTI AL • ,T 2 1 , * REL  LOCATION',/, 

$T2, 'INPUT  FILE  RE  AD  * ,T22, ' I N  TAPD 1 S * , / , T5 , ' BY  TAPDIS*, 
$T21,'FILE  (KRED*  ,/,(T8,I2,T23,  16)) 

WRITE  (108,2700) 

270C  FORMAT  ( /  ,T5 ,  •  OUT  PUT  FILE  SUMMARY  IN  ORDER  OF  ACCESS',//, 
$T2, 'OUTPUT* ,T29,' BUOY  TAPE  V AR* ' S ' , T50 , ' T OT AL  WORDS',/, 
$T3, 'OCB*  ,T13, 'TAPE  F ILE ' , T2 8 , • ACCESS ED  THIS  FILE',T50, 

S'  IN  OUTPUT  FILE* ,/) 

C 

C 

DO  240  I=1,NF 
IXDCB=JDCB( I ) 

KALL=NS£Q  (I  ) 


59  - 

60  - 
61  - 
62  - 

63  - 

64  - 

65  - 

66  - 

67  - 

68  - 

69  - 

70  - 

71  - 

72  - 

73  - 

74  - 

75  - 

76  - 

77  - 

78  - 

79  - 

80  - 
81  - 
82  - 

83  - 

84  - 

85  - 

86  - 

87  - 

88  - 

89  - 

90  - 

91  - 

92  - 

93  - 

94  - 

95  - 

96  - 

97  - 

98  - 

99  - 
100  - 
101  - 
102  - 

103  - 

104  - 
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ICYCLES=NCYC(KALL) 

INVAR=NV(n 

C 

DO  230  N=lf3 

230  IFILNAM(N)=IFILEI100*(KALL-1)+N) 

C 

DO  235  N=lt INVAR 

235  ISVARlN)=IFIte(100*(KALL-l)+4<-N) 

C 

WRITE  (108,3000)  IXDCB, IF ILNAM , I NVAR, ( I SV AR (N ) , N 
$,ICYCLES*-9 

3000  FORMAT  ( T2, 1 3 ,T 12 ,3 A4 ,T29,N ( 1 2, 2X ) ,T52 , 1  5 ) 

X  OUTPUT  I, IXDCB 

CALL  BUFFER  OUT (I XDCB,1 , ILAB,9,  ISTAT) 

IF  (ISTAT. NE. 2)  OUTPUT  ISTAT;  STOP  3 
240  CONTINUE 
C 
C 

C  WRITE  LABELS  TO  BINARY  SEQ.  FILE 

CALL  BUFFER  OUT ILDC B , 1 , IF IL E , LE NOTH , I  ST AT ) 

X  OUTPUT  'LABELS  OUTPUT' 

IF  (ISTAT. NE. 2)  OUTPUT  ISTAT  ;  STOP  1 
C  READ  AND  WRITE  TAPDIS  FILES 
C 
C 

DO  300  I=1,NF 
IXDCB=JDCB( I) 

KALL=NSEQ(I ) 

ICYCLES=NCYC(KALL ) 

KSTART=JFILES{KALL) 

C 

DO  250  J=1,NV(I ) 

IVAR=ILF< I, Jl 

X  OUTPUT  I VAR,KSTART, ICYCLES 

CALL  ROISCdVAR.KST ART, FILE,  ICYCLES) 

IF  (NERR.NE.O)  OUTPUT  NERR  ;  STOP  4 
X  OUTPUT  I  .IXDCB,  ICYCLES 

CALL  BUFFER  0 UT C I XDC8 , 1 , F ILE , IC YCLES, I  ST AT ) 

IF  (ISTAT. NE. 2)  OUTPUT  ISTAT  ;  STOP  4 
250  CONTINUE 
C 

300  CONTINUE 
C 
C 

STOP  'OUTPUT  COMPLETED* 

END 


1, INVAR) 
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-  PROGRAM  GENRAN  - 
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1  -  C  <«<  GENRANOA  >P>;* 

2  -  C  PROGRAM  TO  GENERATE  RWDISC  FILE  OF  KNOWN  SIGNALS. 

3  -  C  USES  IPC  PROGRAM  NORAN  FOR  PSEUDO-RANDOM  NOISE. 

A  -  C  PROGRAMMER:  6.  MARTINEAU  8/2/77 

5  -  DOUBLE  PRECISION  T, PI ,T WOPI ,OFL S ,DF LTH, FL ,OFMS , DFMTH 

6  -  DOUBLE  PRECISION 

7  -  $Wll(20)fWl2(20),W21(20) ,W22(20) ,W3i(20) ,W32(20), 

8  -  $WA1(20) ,WA2(20) , 

9-  $T11(20),T12(20),T21(20) ,122120) ,T31(2C) ,132(20) , 

10  -  $TA1{20)  ,TA2(20)  , 

11  -  $AHl(20),AH2(20) ,AH3{20),AHA(20)  ,AH5(20)  ,AH6{20) , 

12  -  iTHl(20) ,TH2120) ,TH3( 20) ,THA(20) , TH5(20) ,TH6 (20) 

13  -  DIMENSION  KHARM (2 0) , XS 1 ( 20) ,XS2 ( 20) , XS3 ( 2 0) , XSA ( 20) , 

lA  -  $BMEAN(20  ),SDE(20) ,I XA(20) 

15  -  DIMENSION  LABL(A) 

16-  COMMON  81 (2560)  ,KG( 20) ,KNG( 20  ), XG(20  )  ,XNG(2,20) ,FUND{ 20 ) , 

17  -  $AH1,AH2,AH3,AHA,AH5,AH6, 

18-  $TH1,TH2,TH3,THA,TH5,TH6, 

19-  $IOIM, IFL ,TWOPI , LENGTH 

20-  NAMELIST  IG, I NG , AME AN, STDEV , AG, ANG, ASl , AS2 , AS 3 , ASA , IHAR M , 

21  -  $Fil,F12,F21,F22,F31,F32,Pll,P12,P21,P22,P31,P32,KSAME,IX, 

22  -  $FA1,FA2,PAI,PA2, 

23  -  $ASQ,ACUBE,HA1,HA2,HA3,HAA,HA5,HA6,FF, 

2A  -  $HP1,HP2,HP3,HPA,HP5,HP6, 

25-  SNOLIST,  I  DATSTART 

26  -  IDIM=2560  ;  M0DFLG=0 

27  -  IHARM=0 

28  -  IDATSTART=5 

29  -  N0LIST=1 

30  -  PI=3. 141592653589793 

31  -  TW0PI=2.API 

32  -  0TR=PI/180. 

33  -  RTD=180./PI 

3A  -  LABL( 1 )=AHGENR 

35  -  LA8L(2)=AHAN0U 

36  -  LABL(3)=AHTPUT 

37  -  LA8L(4)=0 

38  -  CALL  INGEN 

39  -  CALL  0PAR(NERR,MF,1 ,1,KSUM,512) 

AO  -  N8LKS=LENGTH/ IDIM 

Al  -  MM0D=L£NGTH-IDIM*N8LKS 

42.  -  NBSAVE=N8LKS 

43  -  IUIMSAVE=IDIM 

44  -  C  CALL  NORAN 

45  --  IF  (NSER  lES.GT.MF  )  OUTPUT 

4fe  ~  $*N0.  OF  SERIES  CAN»*T  BE  GREATER  THAN  NO.  OF  LUG.  FILES'; 

47  -  $STOP 

48-  IF  ((MF.EQ.21).AND. (NSERIES.EQ.21))  NSERIES=20  ;  OUTPUT 

49  -  $*N0.  OF  SERIES  HAS  BEEN  SET  TO  20* 

50  -  C 

51  -  C 

52  -  C 

53  -  00  400  IFL=1,NSERIES 

54  -  LZ=-i 

55  -  CALL  WOISC( IFL,1,LABL,A) 

56  ”  IF  (NBLKS.EQ.O)  GO  TO  375 

57  -  305  CONTINUE 

58  -  C 
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59  -  C 

60  - 
61  - 

62  -  C 

63  -  C 

64  - 

65  - 

66  -  C 

67  - 

68  - 

69  - 

70  -  C 

71  - 

72  - 

73  - 

74  - 

75  - 

76  -  C 

77  - 

78  - 

79  -  C 

80  - 

81  -  C 

82  - 

83  - 

84  -  C 

85  -  C 

86  - 

87  -  C 

88  - 

89  - 

90  -  C 

91  - 

92  - 

93  - 

94  - 

95  - 

96  - 

97  - 

98  - 

99  - 
100  - 
101  - 

102  -  C 

103  - 

104  - 

105  - 

106  - 

107  - 

108  -  C 

109  -  C 

110  - 
111  - 
112  - 

113  - 

114  - 

115  - 

116  - 

117  - 

118  - 


KV=IXA(IFL) 

DO  370  J=1,N8LKS 
INITIALIZE  WORKING  ARRAYS 

DO  310  I=1,IDIM 
310  Biin=o. 

IF  (IKGI  IFD.EC.O).  AND.  (KNGIIFL  I.EQ.OH  GO  TO  350 

IF  (MODI I0IMf2) .EQ. 1)  GO  TO  320 

IHALF=IDIM/2 

DO  315  K=l, IHALF 

315  CALL  NORANd  f  KV  ,BME  AN(  I  FL  ) ,  SDEI  IFL)  tBl  {  K)  ,B1  (  K*- IHAL  F)  ) 

GO  TO  330 
320  CONTINUE 

IHALF=IDIM/2 

DO  325  K=1,IHALF+1 

325  CALL  NORANd, KV,BMEAN(IFLI, SDEI  IFLJ.BKK)  ,81(KfIHALF^-l)  ) 


330  CONTINUE 

SUBROUTINE  NOISE  ADDS  GAUSSIAN  PLUS  NON-G.  NOISE 
CALL  NOISE 
350  CONTINUE 


IF  IKHARMIIFD.EQ.O)  GO  TO  355 
SUBROUTINE  HARMONICS  ADOS  1ST  THRU  6TH  HARMONICS 
CALL  HARMONICS 
355  CONTINUE 

DO  360  K=l, IDIM 

DFLS=DFLCATILZ)  ;  DFLTH=OFLOAT I  LENGTH) 

T=TWOPI*DFLS/DFLTH 

N=IFL 

B1IK)=B1  IK)  *■ 

$XSl(N)*DSINlWllIN)*T+TllIN))*DSIN(W12IN)*T«-T12IN)d- 
$XS2IN)*DSINIW21  IN)*Td21  IN)  )  ^DS  IN  I W22I N  ) ♦  T*-T22  I  N )  ) 
$XS3IN)*OSINIW3IIN)*TfT31IN)  )  *05  IN  I W32  IN )  ♦T*-T32 1  N )  )  + 
$XS4IN)*DSIN(W41(N)»Td41IN)  )*DSINIW42IN  )*T4-T42IN)  ) 
360  CONTINUE 

IF  IMODFLG.EQ.l )  GO  TO  365 

CALL  WDISCI  IFL,  ID  AT  START  «•  I J-1 )  *  I DI M,  Bl,  IDIM) 

GO  TO  370 

365  CALL  WDISCI IFL, IDATSTART+NBSAVE*IDIMSAVE,B1, IDIM) 
370  CONTINUE 


375  CONTINUE 

IF  (MMOD.EQ.O)  GO  TO  390 
NBLKS=1 
MOOFLG=1 
IOIM=MMOD 
MMOD=0 
GO  TO  30  5 
390  CONTINUE 

NBLKS=N3SAVE 
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119  - 
12  0  - 
121  - 
122  - 

123  - 

124  - 

125  - 

126  - 

127  - 

128  - 

129  - 

130  - 

131  - 

132  - 

133  - 

134  - 

135  - 

136  - 

137  - 

138  - 

139  - 

140  - 

141  - 

142  - 

143  - 

144  - 

145  - 

146  - 

147  - 

148  - 

149  - 

150  - 

151  - 

152  - 

153  - 

154  - 

155  - 

156  - 

157  - 

158  - 

159  - 

160  - 
161  - 
162  - 

163  - 

164  - 

165  - 

166  - 

167  - 

168  - 

169  - 

170  - 

171  - 

172  - 

173  - 

174  - 

175  - 
1  76  - 

177  - 

178  - 


IOIM=IDIMSAVE 

M0DFLG=0 

MMOD=LENGTH-IDIM*NBLKS 
400  CONTINUE 
C 
C 
C 

CALL  CUISC 
STOP 
C 

c 

C 

c 

SUBROUTINE  INGEN 

C  INTERNAL  SUBROUTINE  FOR  PROGRAM  GENRAN02  TO  INITIALIZE 
C  AND  INPUT  PROGRAM  VARIABLES 
IDEC=0 

WRITE  1108,1000) 

1000  FORMAT  ('INPUT  LENGTH,  NO.  OF  SERIES,  NO.  OF  LOG.  FILES') 
READ  1105,1500)  L ENGTH , NSER I ES , MF 
1500  FORMAT  {3G) 

WRITE  (108,2000) 

2000  FORMAT  ('YOU  WILL  BE  ASKED  TO  INPUT  NAMELIST  VARIABLES 
$•  FOR  EACH  SER  lES.'  ,/, 

$' IG,ING, IHARM  (VALUE  1  OR  0)  ARE  SWITCHES  FOR  GAUSS.,  *, 
$'NON-G.  NOISE,  AND  ',/, 

$T6, 'HARMONIC  SERIES  *♦  DEFAULTS  0,0,0',/, 

S'GAUSSIAN  NOI SE  , 

S'  AG,AHEAN,STDEV  ARE  AMPL I TUOE ,MEAN,ST  DEV.  DEFAULTS  ', 

S'  1,0,1' ,/, 

S'  "SEED"  FOR  SUBROUTINE  NORAN  IS  IX.  DEFAULT  314159',/, 
S' NON-GAUSS  I  AN  NOISE:',/, 

S'  FORM  IS  ASQ*X**2+ACUBE*X**3  WHERE  X  IS  GAUSS.  NOISE  ', 
$/,'  DEFAULTS  ARE  A SQ=ACUBE =1 ' , / , 

S'HARMONIC  SERIES:',/, 

S'  SIX  TERMS. AMPLITUDES  ARE  HAl  THRU  HA6.  FUND  FREQ.  IS', 

S'  FF.',/, 

S'  PHASES  HPI  THRU  HP6  IN  DEGREES.  DEFAULTS  ALL  0',/, 
S'SUM  OF  SIN*SIN  TERMS:',/, 

S'  FOUR  TERMS.  AMPLITUDES  ARE  ASl  ,  AS2  ,  A  S3  ,  A  S4 .  FREQ"S,' 
S, 'PHASES  (IN  DEGREES)',/, 

S'  ARE  FIJ,PIJ  WHERE  1  =  1, 2, 3, 4  REFERS  TO  SIN^SIN  TERM  '  ,/ 
S,'  WITH  AMPL.  ASl ,AS2,AS3,AS4  AND  J=i,2  REFERS  TO  1ST  OR' 
S,'  2ND  FACTOR  ' ,/, 

S'  IN  A  GIVEN  SIN*SIN  TERM.  ♦♦  DEFAULTS  ALL  0.',/, 

S' INPUT  KSAME=(SERIES  NO.)  TO  DUPLICATE  ALL  PARAMETERS  ', 
S/,'FROM  A  PREVIOUSLY  INPUT  SIGNAL.') 

50  CONTINUE 
C 
C 

DO  100  JJ=1,NSERIES 
WRITE  (108,2500)  JJ 

2500  FORMAT  (/, 'ENTER  SIGNAL  PARAMETERS  FOR  SERIES  ',12,'  :') 
KSAME=0 

IF  ( IDEC  .EQ.l  )  GO  TO  60 
IG=ING=IHARM=0 

AG=ANG=1 .; AS1=AS2=AS3=AS4=0. ; AMEAN=a. ;S T0EV=1 . 

ASQ=ACUBE=1 . 

IX=314159 

HA1=HA2=HA3=HA4=HA5=HA6=0. 
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179  - 

lao  - 
181  - 
182  - 

183  - 

184  - 

185  - 

186  - 

187  - 

188  - 

189  - 

190  - 

191  - 

192  - 

193  - 

194  - 

195  - 

196  - 

197  - 

198  - 

199  - 

200  - 
201  - 
202  - 

203  - 

204  - 

205  - 

206  - 

207  - 

208  - 

209  - 

210  - 
211  - 
212  - 

213  - 

214  - 

215  - 
216- 
217- 
218  - 

219  - 

220  - 
22  1  - 
222  - 

223  - 

224  - 

225  - 

226  - 

227  - 

228  - 

229  - 

230  - 

231  - 

232  - 

233  - 

234  - 

235  - 

236  - 

237  - 

238  - 


Fll=Fi2=F21=F22*F31=F32=Pll=P12=P21=P22=P31=P32=0. 

F41=F42=P41=P42=0. 

FF=HP1=HP2=HP3=HP4=HP5=HP6=0. 

GO  TO  70 
60  CONTIMUE 
IX=IXA( J J) 

IG=KG( JJ );ING  =  KNG ( J J ) ; AMEAN=BME AN ( J J ) ; S TOEV=SOE ( J J  J 
IHARM=KHARM( JJ) 

AG=XG( JJ I ;AS1=XS1{JJ1 ;AS2=XS2(JJ» ;AS3=XS3{ JJ) 
AS4=XS4( JJ) 

AS(j=XNG(  1,JJ)  ;ACUBE=XNG(2,JJ) 

HA1=AH1{ JJ) ;HA2=AH2 ( JJ) ;HA3=AH3( JJ) ;HA4=AH4{ JJ ) ; 
HA5=AH5{ JJ) ;HA6=AH6( JJ) ;FF=FUND( JJ) 

HPl=THi{ JJ)/DTR;HP2=TH2( JJ)/DTR;HP3=TH3(J J)/DTR 
HP4=TH41 JJ) /DTR;HP5=TH5( JJ) /DTR ;HP6=TH6 ( J J) /DTR 
F11=W11{ JJ) ;F12=W12( JJ) ;F21=W21(JJ) ;F22=W22(JJ) 
F31=W31{ JJ) ;F32=W32< JJ) 

F4l=W41( JJ) ;F42=W42 ( JJ) 

P11=T11( JJ)/0TR;P12=T12( JJ)/DTR;P21=T21 (JJ)/DTR 
P22=T22( JJ) /DTR;P31=T31( JJ) /DTR;P32=T32 (J J) /DTR 
P41=T41 ( JJ) /DTR ;P42=T42 ( J J) /DTR 
70  CONTINUE 
INPUT 

IF  ((KSAME.NE.O).AND. I KSAME . GT . J J ) ) 

$OUTPUT  'KSAME  TOO  L ARGE ' » KSAMEt JJ  ;  STOP 
IF  (KSAME. EQ-0)  GO  TO  75 
KK=:KSAME 
IXA(JJ)=IXA{KK) 

KG( JJ)=KG(KK) ;KNG( J J)=KNG(KK) ;6ME AN ( J J ) =B ME AN ( KK ) 
KHARMI JJ)=KHARM(KK) 

SDE( JJ)=SDE(KK)  ;  XG ( J J ) =XG ( KK) 

XNGd  ,JJ)=XNGI1  ,KK)  ;  XNG  (  2  ,  J  J)  =XNG  (  2  ,  KK) 
XS1(JJ)=XS1 (KK) ;XS2 ( JJ)=XS2{KK) ;XS3(JJ)=XS3 (KK) 

XS4( JJ)=XS4(KK) 

WlKJ  J)  =  W11(KK)  ;W12(  JJ)=W12(KK)  ;W21  ( J  J )  =W21  ( KK ) 
K22(JJ)=k»22(KK)  ;  W31  (  J  J)  =W31  (  KK)  ;  W32  (  J  J)  =W32  (KK) 
W41(JJ)  =  i»41  (KK)  ;  W42(J  J)=W42IKK) 

TIK  JJ)  =  T11(KK)  ;T12  (  JJ)=T12(KK)  ;  T21  (  J  J)  =T21  (  KK) 

T22( JJ)=T22(KK) ;T31 ( JJ) =T31 ( KK) ;T32( JJ) =T32IKK) 

T41( JJ)=T41(KK)  ;  T42( J J)=T42(KK) 

AH1(JJ)=AH1(KK) ;AH2( JJ)=AH2(KK) ;AH3( JJ) =AH3(KK) 

AH4( JJ)=AH4(KK) ; AH5 ( J J ) =AH5 ( KK ) ; AH6 ( J J ) = AH6 (KK ) 

FUND( JJ)=FUNO(KK) 

THK  JJ)  =  TH1  (KK)  ;TH2  (  JJ)  =TH2(  KK)  ;  TH3  (  J  J )  =TH3  ( KK ) 

TH4( JJ)=TH4(KK) ;TH5 ( J J) =TH5 ( KK ) ;TH6 ( J J) =TH6 (KK ) 

GO  TO  100 
75  CONTINUE 
IXAI JJ)=IX 

KG( JJ)=I G;KNG(JJ)=ING;6MEAN ( JJ)=AMEAN;SDE( JJ)=STDEV 
KHARM( JJ )=IHARM 

XGI JJ)=AG;XS1 ( J J) =ASl;XS2( J J)=AS2;XS3( J J)=AS3 
XS4(J J) =AS4 

XNGd,  JJ)=ASQ;XNG(2,  JJ)  =ACUBE 

AHKJJ  )  =  HA1;AH2IJJ)=HA2;AH3(  JJ)  =HA3;AH4(  J  J)  =HA4; 

AH5( JJ)=HA5;AH6( JJ) =HA6;FUND( JJ )=FF 

THK  JJ)  =  HP1«DTR;TH2(  JJ)  =HP2*UTR  ;TH3  (  J  J)  =HP3«DTR 

TH4( J J)=HP4*DTR ;TH5 ( J J) =HP5*DTR  ;TH6 ( JJ ) =HP6*DTR 

WIK  JJ)=Fll;W12(JJ)  =F12;W21  (  JJ)  =F21;W22(  JJ)=F22 

W31( JJ)=F31;W32(JJ)=F32 

W41(JJ)=F41  ;  W42(JJ)=F42 
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239  - 

240  - 

241  - 

242  - 

243  - 

244  - 

245  - 

246  - 

247  - 

248  - 

249  - 

250  - 

251  - 

252  - 

253  - 

254  - 

255  - 

256  - 

257  - 

258  - 

259  - 

260  - 
261  - 
262  - 

263  - 

264  - 
26  5  - 
266  - 

267  - 

268  - 

269  - 

270  - 

271  - 

272  - 

273  - 

274  - 

275  - 

276  - 

277  - 

278  - 

279  - 

280  - 
281  - 
282  - 
283  - 

28  4  - 

285  - 

286  - 

287  - 

288  - 

289  - 

290  - 

29  1  - 

292  - 

293  - 

294  - 

295  - 

296  - 


TillJJ)=Pll*OTR;T12( JJI =P12*DTR;T21 IJJ)=P21*DTR 
r22(JJ)  =  P22*DTR;T31  ( JJ)  =P31^DTR;T32{  JJ)  =P32<'DTR 
T41( JJ)=P41*DTR  ;  T42( JJJ=P42*DTR 
100  CONTINUE 
C 
C 

IF  (NOL IST.EQ.O )  GO  TO  170 
WRITE  (108,3000) 

3000  FORMAT  I / , • PARAME TE RS  FOR  ALL  SERIES  TO  BE  CREATED  *, 
S'FOLLOW: • ,/ ) 

C 

C 

DO  150  JJ=1,NSERIES 
WRITE  (108,3200)  JJ 

3200  FORMAT  {/,'SERIES  •,I2,':') 

WRITE  (108,3500)  KG ( J J ) , BME AN (J J ) ,SUE ( J J) , I XA ( J J ) , 

SKNG(JJ ),XNG(I ,JJ) , 

$XNG(2,JJ) ,KHARM(JJ) ,FUNO( JJ) , AH 1 ( J J ) , AH2 ( J J ) , AH3 ( J J ) , 
$AH4( J J) , AH5{ J J)  ,AH6 ( JJ ) , THi ( J J ) ♦RTD , TH2 ( J J ) ♦RID , 

$TH3(JJ )*RTD,TH4( JJ)*RT0,TH5( JJ)*RTD,TH6 (J J)*RTD, 
$XS1(JJ),XS2(JJ) ,XS3(JJ) ,XS4( JJ) , 

SWIKJJ)  ,T11(  JJ)*RTD,W12(JJ)  ,  T12  ( J  J  )  *810  , 

$W21(JJ) ,T21( JJ) ♦RTD  ,W22 ( JJ)  , T22 ( J J ) ♦RID , 

$W31( JJ) ,T31( JJ)^RTD  ,W32 ( JJ) , T32 ( J J ) *870 , 

$W41( JJ) ,T41( JJ)^RTD,W42 (JJ) ,T42(JJ)*RTD 
3500  FORMAT  (‘GAUSSIAN  NOISE:  IG=*,I,*  AMEAN= ' ,G 6. 2 , *  STU£V=', 
$G8.2,*  SEEO  =  ‘  ,110,/ , 

$'NON-G.  noise:  ING=',I,*  ASQ=*,G8.2,*  ACU8E= • , G8 . 2 , / , 

t'HARMQNIC  series:  IHARM=',I,‘  FF=',G8.2,/, 

$*HA1=* ,G8.2,'HA2=',G8.2,*HA3=»,G8.2,*HA4=' , G8 . 2 , • HA  5  =  •  , 
$G8 *2,  *HA6=*,G8«2,/, 

t'HPl=* ,G8.2,'HP2=',G8.2, •HP3=' ,G8.2, •hP4=' ,G8.2,'hP5=* , 
$G8.2, •HP6=» ,G8. 2, /, 

S'SUM  OF  SIN^SIN  TERMS: ',/ ,*  AS1  =  ',G8.2,*  AS2=',G8.2, 

$'  AS3=*,G8.2,'  AS4=* ,G8.2,/ , 

$•  Fll=» ,G9.3,5X,«Pll=*,F6.1,8X, •F12=* ,G9. 3, 5X, • P12= • ,F6. 1 

$,/, 

$•  F21=',G9.3,5X,  *821=  *,8  6.1, 8X,  *F22  =  *  ,G  9.  3 , 5X , '  P22=  *  ,  F6 . 1 

it/f 

$•  F31=',G9. 3,5X,»P31=',F6.1 ,8X, •F32=' ,G9. 3 , 5X , • P32= • ,F6. 1 

$,/, 

$•  F41=* ,G9. 3,5X,*P41=* ,F6.1 ,8X, '842=' ,G9. 3 , 5X , • P42= ' , F6 . 1 

$) 

150  CONTINUE 
C 
C 

170  CONTINUE 

WRITE  (108,3700) 

3700  FORMAT  (‘DO  YOU  WISH  TO  RE-ENTER  INPUT  LOOP?',/, 
t'VARIABLES  WILL  REMAIN  AS  SET  UNLESS  CHANGED.',/, 

$ 'ANSWER  YES  OR  NO.' ) 

READ  (105,4000)  NOYES 
4000  FORMAT  (44) 

IF  ((NOYES. NE .4HYES  ) .AND. ( NOYES. NE .4HN0  ))  GO  TO  170 

IF  (NOYES. EQ.4HYES  )  IDEC=1  ;  GO  TO  50 
OUTPUT  'INPUT  COMPLETED' 

RETURN 

END 
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1  -  SUBROUTINE  HARMONICS 

2  -  C  FOR  PROGRAM  GENRAN03  TO  GENERATE  HARMONICS 

3  -  DOUBLE  PRECISION  T , PI  * T WOPI t DFL S ,OFLTH , FL ,OFMS , DFMT H 

4  -  DOUBLE  PRECISION 

5  -  t AHl(20i » AH2(20) tAH3 1 20) » AH4( 20)  f AH51 20)  f AH6( 20) » 

6  -  $TH1{20) ,TH2(20),TH3(20) ,TH4(20) ,TH5{20) ,TH6(20) 

7-  COMMON  Bl(2560) ,KG(20)fKNGI20),XG(20),XNGI2f20) fFUN0(20), 

8  -  $AH1,AH2» AH3fAH4,AH5»AH6, 

9-  $THl,TH2fTH3»TH4,TH5,TH6, 

10  -  $IDIM,IFL.TWOPItLENGTH,MZ 

11  -  C 

12  -  DO  200  K=1,IDIM 

13  -  MZ=MZ«-1 

14  -  OFMS=DFLOAT(MZ)  ;  OFMTH=DFLOATl  LENGTH) 

15  -  T=TWOPI*DFMS/DFMTH 

16  -  N=IFL  ;  FL=FUND(IFL) 

17  -  B1(K)=B1 lK)f 

18-  $AH1(N)*DSIN(  FL*T4-TH1(N)  )  +  AH2(N)*DSIN{  2.*FL*T>TH2(N)  )4- 

19  -  $AH3(N)  ♦□SIN(3.*FL*T  «>TH3  (  N )  ) +AH4  (N )  ♦OS  I N  (4  .*FL<'T  fTH4(N)  )  *■ 

20  -  $AH5(N)*DSIN(5.*FL*T<-TH5(N)  )+AH6(N)*0SINI6.«FL^T+TH6(N)  ) 

21  -  200  CONTINUE 

22  -  C 

23  -  RETURN 

24  -  END 
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1  -  SUBROUTINE  NOISE 

2  -  C  FOR  PROGRAM  GENRAN03  TO  GENERATE  GAUSSIAN  AND  NON-G.  NOISE 

3  -  DOUBLE  PRECISION  T, P I , T WOPl , DFLS t DFLTH, FL , DFMS, DFMTH 

4  -  DOUBLE  PRECISION 

5  -  SAH1(2Q) f AH2(20) f AH3{20) tAH4I20) fAH5I20) »AH6I20) f 

6  -  $TH1(20).TH2I20) fTH3(20) ,TH4(20) ,TH5(20) ,TH6(20) 

7  -  COMMON  81(2560) .KG( 20), KNG( 20), XG{20l,XNG(2, 20) ,FUNO(23 ), 

8  -  $AH1,AH2,AH3,AH4,AH5,AH6, 

9  -  $TH1,TH2,TH3,TH4,TH5,TH6, 

10-  $IOIM,IFL,TWOPI , LENGTH, MZ 

11  -  IF  ((KG(  IFL).EQ.O).OR.{KNG(  IFL)  .EQ.O)  )  GO  TO  250 

12  -  C 

13  -  DO  200  K=1,IDIM 

14  -  200  B1(K)=XG(IFL)*81{K)  ^■XNG{l,IFL)♦al(K)*♦2«• 

15  -  $XNG(2, IFL)*B1(K)**3 

16  -  C 

17  -  GO  TO  500 

18  -  250  CONTINUE 

19  -  IF  (KG( IFL) .EQ.O)  GO  TO  350 

20  -  C 

21  -  DO  300  K=l, IDIM 

22  -  300  B1(K)=XG(IFL)*B1(K) 

23  -  C 

24  -  GO  TO  500 

25  -  350  CONTINUE 

26  -  C 

27  -  DO  400  K=1,10IM 

28  -  400  B1(K)=XNG(I,IFL )*B1 (K)**2+XNG(2,  IFL  )*B1 {K)**3 

29  -  C 

30  -  500  CONTINUE 

31  -  RETURN 

32  -  END 
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PR0GRM4  ORDAT 
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1 

2 

3 

4 

5 

6 
7 

o 

9 

10 
1 1 
12 
I  3 

14 

15 

16 
17 
I  8 

19 

20 
21 
22 

23 

24 

25 

26 

27 

28 

29 

30 

31 

32 

33 

34 

35 

36 

37 

38 

39 

40 

41 

42 

43 

44 

45 

4  6 

47 

48 

49 

50 

51 

52 

53 

54 

55 

56 

5  7 
58 


-  C  <<««<  0  R  D  A  T  S  »»»> 

-  C  PROGRAM  TO  READ  CONSECUTIVE  FILES  PRODUCED  BY  FRAGTAP 

-  C  AND  TO  CONSTRUCT  LARGE  RWDISC  FILE 

-  C  programmer:  G.  MARTINEAU  VERSION  01  3/9/77 

DIMENSION  FILE(18O00),IFILE(2500),ILF(4),NAM0CB(4), 
$IBU0YVAR14) 

EQUIVALENCE  (FILE,IFILE) 

MFILE=2i 

CALL  DPARINERRtMFILEflf l,KSUM,512) 

NWDS=18000 

READ  (lOStlOOO)  NUCB.LDCB 

-  1000  FORMAT  (2G) 

-  C 

-  C 

DO  600  1=1,NDCB 

READ  {I05t2000)  I  DC B,NS ER IE S tNS ERI ES , ( I LF ( J ) , J= 1 , NS ER 1 E S ) 

-  2000  FORMAT  I2G,NG) 

-  C  READ  IN  DATA 

CALL  BUFFER  I N { I DCB , 1 ,F I LE , NWDS , I  ST AT , I NWDS ) 

-  X  OUTPUT  IDCB,( IFILEI K1 ,K=l,9) 

IF  IISTAT.NE.2)  OUTPUT  ISTAT  ;  STOP  1 

IF  (INWDS.NE.9)  OUTPUT  INWDS,IDCB  ;  STOP  10 

NUMVAR=IFILE(4) 

JCYC=IFILEI5» 

-  X  OUTPUT  JCYC 

IF  (NUMVAR.NE.NSERI ES)  OUTPUT  I DCB , NUMV AR , NSE R I ES  ; 
iSTOP  'DISCREPANCY  IN  NO.  OF  VARIABLES' 

-  C 

-  C 

-  C 

-  X  OUTPUT  NUMVAR 

DO  150  N=1,NSERIES 

150  IBUOYVARiN)  =  IFILE  (Ni-5) 

-  C 

DO  200  K=1,NSERIES 
LF=ILF(K) 

CALL  BUFFER  I N( IDCB , 1 ,F ILE ( 10 ) , NWDS ♦ I  ST AT , I NWDS ) 

IF  IINWDS.NE. JCYC )  OUTPUT  N,INWDS,JCYC  ;  STOP  50 

-  C 

DO  170  N=l,3 
170  IFILE(N*-5  )  =  IFILEIN) 

-  C 

IFILE(9)=IBU0YVAR(K) 

-  X  OUTPUT  LF ,JCYC, INWDS 

-  X  WRITE  (108,2222)  K, ( IF ILE (M ) ,M=6,9) , 

-  X  $(FILE(M) ,M=10,24) 

-  X2222  FORMAT  ( IH  , ' K= ' , 1 1 , 2X , 3A4, 3X , I  8, / , ( 5&i 4. 4)  ) 

CALL  WDISC(LF,1  ,FILE(6)  ,JCYC«^4) 

200  CONTINUE 

-  C 

WRITE  (108,3000)  IDCB , ( I F ILE ( J )  ,  J=6 , 8 ) , NSER I ES , JCYC  , 
SNSERIES, (ILF( J) ,J=1 ,NSER I ES ) , NS ER I E S , 

$ (1  BUOY VAR (J),J=1,NS FRIES) 

-  3000  FORMAT  (/, 'OUTPUT  SUMMARY  FOR  DCB  ',I2,/,T16, 

S'BUOY  FILE:  ' ,3A4, / ,T12, • NO.  OF  SERIES:  •,I1,/,T4, 

S'OATA  WDS.  EACH  SERIES:  ',G,/,T4, 

$'WRITTEN  TO  LOG.  FILES:  • , N ( I  2 , 2X) , / , T 11 , 

S'BUOY  VAR.  NOS.:  •  ,  N  ( 1 2 , 2X )  ,  / /) 
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59  - 

60  - 
61  - 
62  - 

63  - 

64  — 

65  - 

66  - 

67  - 

68  - 

69  - 

70  - 


600  CONTINUE 
C 
C 

C  CONSTRUCT  LABEL  FILE 

CALL  BUFFER  IN(LDCBfltIFILE»NWDSfISTAT»IN WD S ) 

IF  (ISTAT.NE.2)  OUTPUT  ISTAT  ;  STOP  2 
CALL  WDISC<2l,ltIFILE,INWDS) 

WRITE  (108,4000)  INWDS 

4000  FORMAT  {/,1H  ,14,'  WORDS  WRITTEN  IN  LABEL  L.  F.  NO. 
CALL  CDISC 
STOP  'NORMAL  END' 

END 
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PROGRAM  RBPLOT05 
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2 

3 

A 

5 

6 

7 

8 
9 

10 

11 

12 

13 

14 
1  5 
16 

17 

18 

19 

20 
21 
22 

23 

24 

25 

26 

27 

28 

29 

30 

31 

32 

33 

34 

35 

36 

37 

38 

39 

40 

41 

42 

43 

44 

45 

46 

47 

48 

49 

50 

51 

52 

53 

54 

55 

56 

57 

58 


C  <«««  RBPLDT05  >»»» 

C  PROGRAM  TO  PLOT  ROTARY  8ICQHERENCES  GENERATED  BY  PROGRAM 
C  BIVECD5  AND  TRANSMITTED  BY  CONSECUTIVE  DISC  FILES. 

C  PROGRAMMER:  GERARD  H.  MARTINEAU 
C  ORIGINATOR:  MELBOURNE  G.  BRISCOE 
C  DATE:  OCT.  18,  1977 

DIMENSION  DAT  A (200,  130) , I SUE (  1000 ) , CONL V ( 15 ) , KAR D{ 2 0 ) , 
$IDENTi(9 ) ,IDENT2( 9)  ,  I CL K ( 4)  , L AB L ( 33 ) , CO NF LV ( 15 ) , 
$lNAMES(i8),IVAR(6), EXCH(200) 

MD1=200  ;  MD2=130 
IPASS=1 

NAMELI ST  IST0RE1,IST0RE2,NDECPL , CMP PT , I BU OY , I  FOUR  I E R , 
$IST0RE3, IST0RE4, WIDTH 
NDECPL=I BUOY=IFOURI ER=1 

ISTQRE1=1  ;  IST0RE2=2  ;  ISTORE3=3  ;  IST0RE4=4 
CMPPr=-l.  ;  WIDTH=8.75 
ISW=1  ;  NVEC=2  ;  KPASS^l 
INPUT 

READ  (105,1111)  KARD 
1111  FORMAT  (20A4) 

WRITE  (108,1122)  KARD 
1122  FORMAT  (X,20A4) 

DECODE  (80,3333  , KARD)  I W 1 , 1 W2 , 1 W3,LP I  EC E , SAMP SE C , FR EQ 1 1 C 
3333  FORMAT  (6G) 

IF  ( (  IWl  .EQ.IW2  ). AND. ( I W1 . EQ . 1 W 3 ) . AND. ( IW2.EQ. I W3) ) 
$NVEC=1 

IF  ((NVEC.EQ.2).AN0.(IW1.NE.IW2))  I SW=3 
LPHALF=LPIECE/2  ;  LPATHE=LP IECE/8 
IF  (CMPPT.LT.O. )  CMPPT=WIDTH*2.54/LPHALF 
LPQU=LPI ECE/4  ;  L P3 8=LP ATHE »3 
LP58=LPATHE*'5  ;  LP34=LPATHE*6 
READ  (105,1111)  KARO 
WRITE  (108,1122)  KARD 

DECODE  ( 80,2222 , KARD)  NCONL V , NCQNLV , (CONL V ( I ) , I = 1 , NCONL V ) 
$,NCONLV, (CONFLV(I), I=I,NCONLV) 

2222  FORMAT  (G,NG,NG) 

READ  (105,1111)  KARD 
WRITE  (108,1122)  KARD 
DECODE  (80, 4444, KARD)  I  DENT  1 ,  ID ENT2 
4444  FORMAT  (9A4,9A4) 

C 

C 

30  CONTINUE 

C  READ  ROTARY  BICOHERENCES  INTO  ARRAY  DAT A ( 20 0 , 1 30 ) 

C  FIRST  SET  ARRAY  DATA  TO  -999. 

C 

C 

DO  50  J=1,MD2 

C 

DO  50  I=1,MD1 
50  DATA! I , J  J=-999. 

C 

C 

DO  60  ISQ=1,16 
CALL  BIASdPASS) 

X  OUTPUT  I BIASR, I BIASC 

IFKIPASS.EQ.l)  .AND.(KPASS.EQ.1))IST0RE0=IST0RE1;G0  TO  55 
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59  -  IF((IPASS.EQ.2).AND.(KPASS.EQ.lJnSTOREO=ISTORE2;GO  TO  55 

60-  IF((IPASS.EQ.1)  .AND.  (KPASS.EQ.2)nSTORED=ISTORE3;GO  TO  55 

61  -  IF ( ( IPASS.EQ.2) .AND . (KPASS.EQ.2 ) ) ISTOREO= IST0RE4;G0  TO  55 

62-  55  READ  (ISTORED)  ( { DA TA{ I BI AS R+ I # IBI ASCfJ ) » 1=1 t LP ATHE ) , 

63  -  $J=l,LPATHE) 

64  -  C  WRITE  (108,5353)  ( (  DATA  (  I BI  ASR*- 1 ,  IBI ASC  fJ  ) ,  1  =  1 ,  LPATHE  ) , 

65  -  C  $J=1,LPATHE) 

66  -  C5353  FORMAT  (X,5G14.41 

67  -  60  CONTINUE 

68  -  C 

69  -  C 

70  -  C  REARRANGE  DATA  MATRIX  IF  NECESSARY 

71  -  IF  (KPASS.NE.2)  GO  TO  67 

72  -  C 

73  -  C 

74  -  DO  66  J=l,LPHALF/2 

75  -  C 

76  -  DO  61  1=1, MDl 

77  -  61  EXCH(  n=DATA{  I,  J) 

y  8  —  C 

79  -  DO  63  1  =  1, MDl 

80-  63  DATA(I,J)=DATA(I,LPHALFfl-J) 

81  -  C 

82  -  DO  65  1=1, MDl 

83  -  65  DATA! I ,LPHALF*1-J)=EXCH{ I ) 

84  -  C 

85  -  66  CONTINUE 

86  -  C 

87  -  C 

88  -  67  CONTINUE 

89  -  IF  {( IPASS.EQ.2 ) . AND. (KPASS.EQ. 1) )  GO  TO  360 

90  -  IF  (dPASS. EQ.l). AND. (KPASS.EQ. 2)  )  GO  TO  190 

91  -  IF  (( IPASS.EQ.2). AND. (KPASS.EQ. 2) )  GO  T 0  195 

92  -  C  READ  FOURIER  LABELS 

93  -  C 

94  -  C 

95  -  68  DO  70  1=1,6 

96-  READ  I ISTOREl )  ( I NAME S ( J ) , J  =  3* I -2, 3* I ) , I V AR ( I ) 

97  -  70  CONTINUE 

98  -  C 

99  -  C 

100  -  READ  ( ISTOREl )  MF 

101  -  READ  (ISTOREl)  LABL 

102  -  CALL  PLOTS! IBUF, -1000) 

J03  -  CALL  PLOTIO. ,0.5,-3) 

104-  WRITE  (108,1000)  (CONLV ( I ) , 1=1 , NCONLV ) 

105  -  1000  FORMAT  (/, 'CONTOUR  LEVE LS :',/,( IH  ,5G13.3,/)) 

106  -  CALL  DIMWH(DATA,MD1,MD2) 

107  -  CALL  FLAGZ(-999.0) 

108  -  CALL  NOLABL 

109  -  DEL=CMPPT/2.54 

110  -  AXLEN=LPHALF*OEL 

111  -  SAMPHR=SAMPSEC/3600. 

112  -  DFT0T=1./{2.<'SAMPHR) 

113  -  distic=axlen*freqtic/dftot 

114  -  AYLLEN=(  INT(AXLEN/DISTIC)<-1  (♦DISTIC 

115  -  AYHLEN=AXLEN/2.«-0.25 

116  -  FIRSTV=-(AYLLEN/OISTIC)«FREQTIC 

117  -  C  PLOT  IDENTIFICATION 

118  -  EXPLOT=AXLEN<-AYHLEN 
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119  - 

120  - 
121  - 
122  - 

123  - 

124  - 

125  - 

126  - 

127  - 

128  - 

129  - 

130  - 

131  - 

132  - 

133  - 

134  - 
135- 

136  - 

137  - 

138  - 

139  - 

140  - 

141  - 

142  - 

143  - 

144  - 

145  - 

146  - 
]  47  - 

148  - 

149  - 

150  - 

151  - 

152  - 

153  - 

154  - 

155  - 

156  - 

157  - 

158  - 

159  - 

160  - 
161  - 
162  - 

163  - 

164  - 

165  - 

166  - 

167  - 

168  - 

169  - 

170  - 

171  - 

172  - 

173  - 

174  - 

175  - 

176  - 

177  - 

178  - 


WYEPLOT=AXLEN 
IF  tNVfcC.EQ.l)  GO  TO  100 

CALL  SYfiBOL  ( EXPLOTi- 8.3  ,  WYEP  LOT-0. 8,  0. 31 5, 

$*ROTARY  CROSS  B  ICOHERENCE • , -90. ,24) 

GO  TO  120 

100  CALL  SYMB0L(EXPL0Tfr8.3, WYEPLOT-0.9,0.315, 

$'ROTARY  AUTO  BICOHERENCE  * ,-90. , 23 ) 

120  CONTINUE 

IF  tlBUOY.EQ.O)  GO  TO  125 

CALL  SYMBOL  (EXP  LOT<- 7. 8,  WYE  PLOT- 1.7, 0.210, 

S'COMPONENTS  OF  VECTOR  S ER  IE S* ,-90 . , 27 ) 

CALL  5YMB0L(EXPL0T«-7.4,HYEPL0T-1.6,0.175, 

$‘ORIGINAL  FILE  NAME S : • , -90. , 20 ) 

CALL  SYMBOL  (EXPLOT<- 7.4,  WYEPLOT-5. 7,0.  17  5, 

S'VARIABLE  NUMBE RS : •  ,-90 . ,  17  ) 

CALL  SYMBOL (EXPLOT+7.1,WYEPLOT-0. 5,0. 14,* FREQUENCY  1:', 
S-90.,12» 

CALL  SYMBOL  (EXPL0T4-6. 5,  WYEPLOT-0. 5,0. 14,*  FREQUENCY  2:', 
$-90. ,12) 

CALL  SYMB0L(EXPL0T«-5. 9,  WYEPLOT-0. 5, 0.14, ‘FREQUENCY  3:', 
$-90., 12) 

125  CONTINUE 

IF  ((MF.NE.21 ).0R.( IFOURIER.EQ.G) )  GOTO  130 
CALL  SYMB0L(EXPL0T<-5.1,WYEPL0T-2.9,0.17  5, 

S'PROCESSING  HISTORY* ,-90. ,181 
CALL  SYMBOL ( EXP LOT >4. 8, WYEPLOT-0. 7, 0, 105, LA 8L, -90. ,72) 
CALL  SYMBOL (EXP L0T*4. 5, WYEPLOT- 1.3, . 105 ,LABL( 19 ) ,-90., 60) 
130  CONTINUE 
C 
C 

IF  (IBUOY.EQ.O)  GO  TO  150 
DO  135  1=1,3 

CALL  SYMBOL  (EXPLOT*  7.  l-O.E^'I  I-l  )  ,WYEPL0T-2.  5,0.  14, 

$  I  NAMES (6* 1-5) ,-90., 12) 

CALL  SYMBOL (EXPL0T*6. 85-0.6 ♦( I- 1 ) , WYEPLOT -2 . 5 , 0 . 14, 
$INAMES(6*I-2) ,-90., 12) 

FVAR=FLOAT( IVAR(2*I-1) ) 

CALL  NUMBER ( EXPLOT* 7. 1-0.6* { I-l  ), WYE PLOT- 7. 1,0. 14,FVAR, 
$-90.,-l) 

FVAR=FLOAT( I VAR (2*1 ) ) 

135  CALL  NUMBER{EXPL0T*6.85-0.6*( I-l) ,WYEPL0T-7. 1,0. 14,FVAR, 
$-90.,-l) 

C 

C 

150  CONTINUE 

CALL  SYMB0L(EXPL0T*1.15,WYEPL0T-1.0,0.210,I0ENT  L,-9  0.,3  6) 
CALL  SYMBOL ( E XPLOT* 0. 85 , WYE  PLOT-1 .0 , 0. 2 10 , 1  DENT 2 ,-90 ., 36) 
CALL  TODAY! ICLK ) 

CALL  SYMBOL (EXPLUT*3.0, WYEPLOT-0. 6,0. 175, ’T IME  OF  PLOT:', 
$-90., 13) 

CALL  SYMBOL ( EXP L0T*2 . 7 , WYEPLOT-0. 3, 0. 17 5 , ICLK ,-90. , 1 6 ) 
CALL  SYMBOL (EXP LOT* 3. 8, WYEPLOT- 3. 8, 0.140, 

$*CONTaUR  LEVELS  AND  PERCENT  CON F I DENCE • , -90 . , 37 > 

81 ASX=BIASY=0. 

C 

C 

IF  (NCQNLV.GT.IO)  NC0NLV=10 
DO  185  I  =  1,NC0NLV 

IF  (I.EQ.6)  BIASX=0.  ;  B IASY=B IASY-3 .0 

CALL  NUMBER IEXPL0T*3.3*BIASX,WYEPLOT-4.0*BI AS Y, 0.210, 
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179  - 

180  - 
181  - 
182  - 
183  - 
18A  - 
18  5  -  C 
186  - 
18  7  -  C 
18  8  - 

189  - 

190  -  C 

191  - 

192  - 

193  -  C 

194  - 

195  - 

196  -  C 

197  - 

198  - 

199  - 

200  -  C 

201  - 
202  ~ 

203  - 

204  - 

205  - 

206  - 

207  - 

208  - 

209  - 

210  -  C 

211  - 
212  - 

213  - 

214  -  C 

215  - 

216  -  C 

217  - 

218  - 

219  -  C 

220  - 
221  - 
222  - 

223  -  C 

224  - 

225  - 

226  -  C 

227  - 

228  - 

229  - 

230  -  C 

231  - 

232  - 

233  - 

234  - 

235  - 

236  - 

237  - 

238  - 


$CONLV( I) f-90. ,3) 

CALL  NUMBER(EXPLOTf3.3<-BIASX,  WY6PLOT-5.  4<-BI  AS  Yt  0.210* 
$CONFLV( I  1 ,-90. » 1) 

BI ASX=BIASX-0.4 
185  CONTINUE 

190  IF  (KPASS.EQ.l)  GO  TO  200 
ESTABLISH  NEW  PLOT  ORIGIN 
CALL  PLOTIO.,-0.25,-3) 

Y-AXIS  WITH  TIC  MARKS  ONLY,  STARTING  AT  Wl=0 

CALL  AXWJS(AYLLEN,0.,*  • , 1, AXLEN, 90. , 0. , I . , DI ST  I C , -  1 , 0 , 0, 
$0. 12, .7, .0001,. 14) 

Y-AXIS  STARTING  AT  MAX  Wl 

CALL  AXWJSI AYLLEN+AYHLEN,0., •FREQ2  (CPH )*,- 1 1 , AXLEN , 90. , 
$0. ,FREQT IC.DIST IC ,NDECPL,0,0 ) 

Y-AXIS  STARTING  AT  MIN  Wl 

CALL  AXWJSIO. ,0., •FREQ2  ( CPH ) • , 11 , AXLEN, 90. , 0 . , FREQT I C, 
$OISTIC,NDECPL  ,0,0) 

X-AXIS 

FIRSTV=-I AYLLEN/D IS  TIC) ♦FREQT IC 

CALL  AXORAWIO.  ,AXLEN«-0.  2, 'FREQl  (  CPH)  •  ,  H  ,  AYHLEN<“AYLLEN  , 
$0.,FIRSTV, FREQT  IC,D 1ST IC,NDECPL  ) 

DRAW  BOUNDARIES 

CALL  PLOT lAYLLEN.O. ,3) 

CALL  PLOT  (AYLLEN-AXLEN, AXLEN, 2) 

CALL  PLOT (AYLLEN, AXLEN, 2) 

CALL  PLOT  (AYLLEN<-AXLEN/2.,AXLEN/2.,2) 

CALL  PLOT (AYLLEN, 0. ,2) 

CALL  grid (AYLLEN-AXLEN, AXLEN, DEL, -DEL) 

CALL  WHCNTR(DATA,  1 ,  L  PQU  <-LPH  ALF*^  1 , 1 ,  LPhA  LF  ,  NCUNL  V ,  CONL  V) 
CALL  PLOT (0.,0. ,999) 

192  CONTINUE 

BEGIN  PROCEDURE  FOR  PLOTTING  NEGATIVE  SUM  FREQUENCIES 
IPASS  =  2 
GO  TO  30 
195  CONTINUE 

ESTABLISH  NEW  PLOT  ORIGIN 
CALL  PLQT(0.,0.6,-3) 

Y-AXIS  WITH  TIC  MARKS  ONLY,  STARTING  AT  W1=0 

CALL  AXWJS(AYHLEN, AXLEN,*  • 1 , AXLEN,-9 0. , 0 . , 1. , D IS T IC , 

$— 1,0, 0,0 .12,. 7, .0001, .14) 

Y-AXIS  STARTING  AT  MAX  Wl 
FIRSTV=0. 

CALL  AXWJS(AYHLEN<-AYLLEN,  AXLEN,  •FREQ2  (  CPH  )  '  ,  1 1 ,  AXL  EN, 
$-90.,FIRSTV,FREQTIC,DISTIC,NDECPL,0,0) 

Y-AXIS  STARTING  AT  MIN  Wl 

CALL  AXWJS(0. , AXLEN, •FREQ2  ( CPH  ) ' , -11 , AXL EN ,-90. ,F 1 RST V , 
$FREQTIC,DISTIC,NDECPL,0,0) 

X-AXIS 

FIRSTV=- (AYHLEN/DISTIC) ♦FREQT IC 

CALL  AXDRAW(0.,-0.2, ‘FREQl  ( CPH  ) ' ,- 11, AYHLEN^AYLLEN , 

$0. ,FIRSTV,FREQTIC,DISTIC,NDECPL) 

DRAW  BOUNDARIES 

CALL  PL0T(AYHLEN,0. ,3) 

CALL  PL0T(AYHLEN-AXLEN/2. ,AXLEN/2.,2) 

CALL  PLOT (AYHLEN, AXLEN, 2) 

CALL  PLOT  (AYHLEN<-AXLEN,0.,2  ) 

CALL  PL0T(AYHLEN,0. ,2) 

CALL  GRI D( AYHLEN- AXLEN/ 2. , AXL EN-DEL,D£L,-DEL) 

CALL  WHCNTR(DATA,1  ,LPQU4-LPHALF  +  1, 1,  LPHALF, 

$NCONLV,CCNLV) 
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239  - 

240  - 

241  - 

242  - 

243  - 

244  - 
2  45  - 

246  - 

247  - 

248  - 

249  - 

250  - 

251  - 

252  - 

253  - 

254  - 

255  - 

256  - 

257  - 

258  - 

259  - 

260  - 
261  - 
262  - 

263  - 

264  - 

265  - 

266  - 

267  - 

268  - 

269  - 

270  - 

271  - 

272  - 

273  - 

274  - 

275  - 

276  - 

277  - 

278  - 

279  - 

280  - 
281  - 
282  - 

283  - 

284  - 

285  - 

286  - 

287  - 

288  - 

289  - 

290  - 

291  - 

292  - 

293  - 

294  - 

295  - 

296  - 

297  - 

298  - 


CALL  PLaT(0.,0. ,3) 

GO  TO  400 
C 
C 

200  CONTINUE 

C  X-AXIS  WITH  TIC  MARKS  ONLY,  STARTING  AT  ORIGIN 

CALL  AXWJSI AXLEN.AXLEN, •  • , -1 , AXLLN , -90 . , 0. , 1 D I ST !C , 

$-1,0,0,. 12, .7,. 0001, .14) 

C  X-AXIS  STARTING  ABOVE  MAX  Y  VALUE 

CALL  AXDRAW(AXLEN«-AYHLEN,AXLEN, 'FREQl  (CPH)*,11, 
$AXLEN,-90.,0. ,FREQT IC ,0  I  ST IC ,NDECPL ) 

C  X-AXIS  STARTING  BELOW  MIN  Y  VALUE 

CALL  AXDRAW(AXL£N-AYLLEN,AXLEN, 'FREQl  (CPH)',-11, 
SAXL£N,-90.,0. ,FREQT IC ,0  I  ST  I C , NDECPL ) 

C  Y-AXIS  FOR  TWO  SERIES 

CALL  AXURAW(AXLEN-AYLLEN,AXLEN, •FREQ2  (CPH)',11, 
$2*AYLLEN,0. ,F I RST V, FREUT I C, D 1ST IC, NDECPL) 

C  DRAW  BOUNDARIES 

CALL  PLOT (0.,0. ,3) 

CALL  PLOT {AXLEN,AXLEN,2 ) 

CALL  PLOT (1.5*AXLEN,AXLEN/2. ,2) 

CALL  PLOT  (AXLEN,0.,  2) 

CALL  PLOT (0.,0. ,2) 

220  CALL  GRID(0.,AXLEN-DEL,D£L,-DEL) 

CALL  WHCNTR  (DATA,  1,  LPHALF  *-L  PQU*- 1 , 1 ,  LPHA  LF ,  NCONL  V ,  CONL  V  ) 
230  CALL  PLOT  10., 0.  ,999  ) 

250  CONTINUE 

C  BEGIN  PROCEDURE  FOR  PLOTTING  NEGATIVE  SUM  FREQUENCIES 
IPASS=2 
GO  TO  30 
360  CONTINUE 

AYHLEN=(  INT(  AXLEN/(  2.*DISTIC  )  )<-l)*DISTIC 
C  ESTABLISH  NEW  PLOT  ORIGIN 
CALL  PLOT  (0.,0.  ,-3) 

C  X-AXIS  WITH  TIC  MARKS  ONLY,  STARTING  AT  W2=0 

CALL  AXW JS( AYHLEN,a.  ,  '  * , 1, AXLE N , 90. , 0. , 1 . , D I  ST  I C ,- 1 , 

$0,0, .12, .7, .0001, .1 4) 

YINT=AINT(AXLEN/DISTIC) 

FIRSTV=-FREQT IC*YINT 
YLTH=DIST  IC*YINT 
C  X-AXIS  STARTING  AT  MAX  W2 

CALL  AXDRAW(AYHLEN<-AYLLEN,YLTH, 'FREQl  (  CPH )  •  ,  1 1 ,  YLTH, 
$-90., FIRSTV,FREQT IC ,DISTIC, NDECPL ) 

C  X-AXIS  STARTING  AT  MIN  W2 

CALL  AXDRAHIO. , YLTH, 'FREQl  ( CPH ) ' , -1 1 , YL T H, -90. , F IR ST V , 
$FREQT  IC,D  IS  TIC,  NDECPL) 

C  Y-AXIS 

FIRSTV=-( AYHLEN/DISTIC)*FREQTIC 

CALL  AXDRAW(0.,AXLEN*0.2,  •FREQ2  (  CPH )  •  ,  1 1 ,  A  YHLE  N '-AYLL  EN  , 
$0. ,FIRSTV,FREQT IC , D I  ST  I C , NDECPL ) 

C  DRAW  BOUNDARIES 

CALL  PLOT  I AYHLEN,0. ,3) 

CALL  PLOT (AYHLEN-AXLEN/2. ,AXLEN/2. , 2) 

CALL  PL0T(AYHLEN,AXL£N,2) 

CALL  PLOT (AYHLEN+AXLEN, AXLEN,2) 

CALL  PLOT (AYHLEN,0. ,2) 

CALL  GRID  (AYHLEN-AXLEN/2.  ,AXLEN  ,DEL,-DEL  ) 

CALL  WHCNTR(DATA,1,  L  PQU  fLPHALF'-l,  1,  LPHALF,  NCONL  V,  CONL  V) 
400  CALL  PLOT  (0. ,-.25 ,999) 

C  PLOT  POSITIVE  SUM  FREQUENCIES  FOR  /W2/>/Wl/  IF  ISW=3 
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299 

300 

301 

302 

303 

304 

305 

306 

307 

308 

309 

310 

311 

312 

313 

314 

315 

316 

317 

318 

31  9 

320 

321 

322 

323 

324 

32  5 

326 

327 

328 

329 

330 

331 

332 

333 

334 

335 

336 

337 

338 

339 

340 

341 

342 

343 


IF  ((  ISW.E(3-3).AND.  (KPASS.EQ.l)  J  KPASS=2  ;  IPASS=1  ; 

$  GO  TO  30 

STOP  ‘NORMAL  PROGRAM  COMPLETION* 

Q  ♦♦♦♦♦♦♦  ♦♦♦♦♦♦♦♦  ♦♦♦♦♦♦♦♦  ♦♦♦♦♦♦♦♦♦♦♦♦♦*♦♦♦♦♦♦  ♦♦♦♦ 

SUBROUTINE  BIAS(IP) 

C  INTERNAL  SUBROUTINE  FOR  PROGRAM  RBPLOT 

4  GO  TO  16  f 8) ,IP 

6  GO  TO  (10,15t 15tl0,20f25,25.20f 10,15fl5il0f25t30,30,35) t 
$ISQ 

8  GO  TO  ( 30 »40» 40 f 30 f 35t 50t 50  I 35f 30 140»40 f 30 » 50 f 60 f 60 f 20)  » 
$1SU 

10  CALL  ASNlIBIASRfl)  ;  GO  TO  65 
15  CALL  ASNlIBIASRfZ)  ;  GO  TO  65 
20  CALL  ASNI  IBIASR,3)  *.  GO  TO  65 

25  CALL  ASN {  I8IASRf4)  ;  GO  TO  65 

30  CALL  ASNI  IBIASRt5  )  *.  GO  TO  65 

35  CALL  ASNII8IASR.6)  *,  GO  TO  65 

40  CALL  ASNI  IBIASR,7)  ;  GO  TO  65 

50  CALL  ASNIIBIASR,8)  ;  GO  TO  65 

60  CALL  ASNI  IBIASR,9)  ;  GO  TO  65 

65  GO  TO  I67t68) t I P 

67  GO  TO  170,70,75,75,75,75,80,80,00,80,85,85,85,85,80,85), 

$ISQ 

68  GO  TO  (85,85,80,80,80,80,75,75,  75,75,70,70,  70,70,75  ,70), 
$1SQ 

70  CALL  ASNI  IBIASC,6)  ;  RETURN 
75  CALL  ASNI I0IASC,5)  ;  RETURN 
80  CALL  ASNI IBIASC,4)  ;  RETURN 
85  CALL  ASNI  IBIASC,2)  ;  RETURN 
90  RETURN 

(;♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦*♦♦♦♦♦*♦♦*♦♦*♦♦♦**♦♦♦*♦*♦*********** 

SUBROUTINE  ASNI IB , IS ) 

5  GO  TO  1 10,20,  30,40, 50,60,70 ,80,90) , IS 


10  IB=LPHALF*-1  ;  RETURN 

20  IB=LP38  ;  RETURN 

30  IB=LP58+1  ;  RETURN 

40  I8=LPQU  ;  RETURN 

50  IB=LPATHE  ;  RETURN 

60  IB=0  ;  RETURN 

70  IB=LPQUfl  :  RETURN 

80  IB=LP38+1  ;  RETURN 

90  IB=LPHALF+1  ;  RETURN 

95  RETURN 
END 
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PROGRAM  RBPLOT06 
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1  -  C  ««<«  RBPL0T06  >»»» 

2  -  C  PROGRAM  TO  PLOT  ROTARY  BICOHERENCES  GENERATED  BY  PROGRAM 

3  -  C  eiVECOS  AND  TRANSMITTED  BY  CONSECUTIVE  DISC  FILES. 

4  -  C  CREATES  SINGLE  30  IN  CALCOMP  PLOT  OVER  ENTIRE  DOMAIN 

5  -  C  PROGRAMMER:  GERARD  H.  MARTINEAU 

6  -  C  ORIGINATOR:  MELBOURNE  G.  BRISCOE 

7  -  C  DATE:  NOV.  3,  1977 

8  -  C 

9  -  DIMENSION  DAT  A(  200,  130)  ,  IBUF  {  1000  ) ,  COM  V  (  15  )  ,  KARD(  20  )  , 

10  -  $IOENTi( 9 ) , IDENT2( 9) ,ICLK(4) ,LABL( 33) ,CONFLV (15) , 

11  -  $INAMES(i8),IVAR{6),EXCH(200),XDATA(13C,200),IFREQ(3) 

12  -  EQUIVALENCE  (DATA.XDATA) 

13  -  MD1=20U  ;  MD2=130 

14  -  IPASS=1 

15-  NAMELIST  I  STORE  1 , I  STORE  2, NDECPL ,CMPPT , I  BUOY , I  FOUR  I ER , 

16  -  $IST0Re3,IST0RE4,ISCR,K0MPACT, WIDTH 

17  -  NOECPL=I BUOY= IF0URIER=1 

18  -  IST0RE1=1  ;  IST0RE2=2  ;  IST0RE3=3  ;  IST0RE4=4  ;  ISCR=5 

19  -  CMPPr=-i.  ;  WI0TH=24. 

20  -  ISW=1  ;  NVEC=2  ;  KPASS=1  ;  K0MPACT=0 

21  -  INPUT 

22  -  READ  (105,1111)  KARO 

23  -  1111  FORMAT  (20A4) 

24  -  WRITE  (108,1122)  KARD 

25  -  1122  FORMAT  (X,20A4) 

26  -  DECODE  ( 80, 3333 , KARD )  I W 1 , 1 W2, I W3 , LP I  EC E, SAMPSE C , FR EQT I C 

27  -  3333  FORMAT  (6G) 

28  -  IF  (CMPPT.LT.O.  )  CMPPT=WIDTH<‘2.  54/LPI  ECE 

29-  IF  (( IW1.EQ.IW2).AN0.(IW1.EQ.IW3) .AND. ( IW2.EQ.IW3) ) 

30  -  $NVEC=1 

31-  IF  ((NVEC.EQ.2).AND.(IW1.NE.IW2))  I SW=3 

32  -  C  CHECK  FOR  EXISTENCE  OF  DCB  ASSIGNMENTS 

33  -  CALL  GETDCBI ISTOREl ,L0CC) 

34  -  CALL  G£TDCB(IST0RE2 ,L0CC) 

35  -  IF  (ISW.NE.3)  GO  TO  10 

36  -  CALL  GETDCBt IST0RE3,L0CC) 

37  -  CALL  GETDCB(ISTQRE4,L0CC) 

38  -  CALL  GETDCB(ISCR,LOCC) 

39  -  10  CONTINUE 

40  -  LPHALF=LPIECE/2  ;  L P ATH E=LP I ECE /8 

41  -  LPQU=LPIECE/4  ;  LP3 8=LP ATHE *3 

42  -  LP58=LPATHE*5  ;  LP3 4=LP ATHE *6 

43  -  READ  ( 105,1111)  KARD 

44  -  WRITE  (108,1122)  KARD 

45  -  DECODE  (80, 2222, KARD)  NCONL V , NCQNLV , ( CONL V ( I ) , I = 1 , NCONL V ) 

46  -  $,NCONLV,(CONFLV(I),I=1,NCONLV) 

47  -  2222  FORMAT  (G,NG,NG) 

48  -  READ  (105,1111)  KARD 

49-  WRITE  (108,1122)  KARD 

50  -  DECODE  (80, 4444, KARD)  I  DENT  1 , IDENT2 

51  -  4444  FORMAT  (9A4,9A4) 

52  -  C 

53  -  C 

54  -  30  CONTINUE 

55  -  C  READ  ROTARY  BICQHERENCES  INTO  ARRAY  DATA! 200, 130 ) 

56  -  C  FIRST  SET  ARRAY  DATA  TO  -999. 

57  -  C 

58  -  C 


59 

60 
61 
62 

63 

64 

65 

66 

67 

68 
69 
7  0 

71 

72 

73 

74 

75 

76 

7  7 

78 

79 

80 
81 

8  2 

83 

84 

85 

86 

87 

88 

89 

90 
9  I 

92 

93 

94 

95 

96 

97 

98 

99 
100 
101 
102 

103 

104 

105 

106 

107 

108 

109 

110 
111 
112 
1  1  3 

114 

115 

116 

117 

118 
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DO  50  J=lfMD2 
C 

DO  50  I=lfMDl 
50  DATA! I » J )=-999. 

C 

C 

DO  60  ISQ=1»16 
CALL  BIAS(IPASS) 

X  OUTPUT  I BIASR»IBIASC 

IF( (IPASS.EQ.l) .ANU.(KPASS.EQ.l))ISTOKED=ISTOREl;&U  TO  55 
IF ( ( I  PASS .EQ.2) .AND . (KP ASS. EQ.l n ISTORED= ISTQRE 2 ;&U  TO  55 
IFldPASS.EQ.l)  .AND.(KPASS.EQ.2))ISTORED=ISTORE3;GO  TO  55 
IFdlPASS. EQ.2)  .AND. (KPASS.EQ.2))IST0RED=IST0RE4;G0  TO  55 
55  READ  (ISTORED)  I  (  DAT  A(  1 81  AS  R  +  l  ♦  IBI  ASC<-J  )  t  1  =  1 ,  LPATHE  ) , 
SJ=1,LPATHE) 

60  CONTINUE 
C 

C 

C  REARRANGE  DATA  MATRIX  IF  NECESSARY 
IF  (KPASS.EQ.l)  GO  TO  80 
C 
C 

DO  66  J=l,LPHALF/2 
C 

DO  61  1=1, MDl 

61  EXCH(  I  )  =  DATA(  I,  J) 

C 

DO  63  1=1, MDl 

63  DATAI  I  ,J)=DATAt  I,LPHALFfl-J  ) 

C 

DO  65  1=1, MDl 

65  DATA(I,LPHALF*^l-J)  =  EXCH(n 
C 

66  CONTINUE 


C 

67  CONTINUE 

IF  UPASS.EQ.2)  REWIND  ISCR 

WRITE  (ISCR)  {  (DATA(  I,J)  ,I  =  l,LP34d)  ,J=LPHALF,1,-1) 
C 
C 

DO  75  J=1,MD2 
C 

DO  75  1=1, MDl 
75  DATA! I , J)=-999. 

C 

C 

REWIND  ISCR 
IF  (IPASS.EQ.l) 

$READ  (ISCR)  I  (XDATA(I,J),J=1,LP34<-1),I  =  2,LPHALF<-1) 
IF  (IPASS.EQ.2) 

SREAD  (ISCR)  I  (XDATA(  I,  J)  ,  J=1,LP34*-1)  ,1  =  1,  LPHALF) 

80  CONTINUE 

IF  (( IPASS.EQ.2). AND. (KPASS.EQ.l))  GO  TO  200 
IF  ((  IPASS.EQ.l). AND. (KPASS. EQ.2))  GO  TO  300 
IF  ((IPASS.EQ.2). AND. (KPASS. EQ.2))  GO  TO  400 
C  INITIALIZING  PLOT  CALLS 

CALL  PLOTS! IBUF, -1000) 

CALL  PLOT(0.,0. ,-3) 

C  GENERAL  SETUP  FOR  WHCNTR 
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119  - 

120  - 
121  - 
122  - 

123  - 

124  - 

12  5  - 
126  - 
12?  - 
128  - 

129  - 

130  - 

131  - 

132  -  C 

133  - 

134  - 

13  5  - 

136  - 

137  - 

138  - 

139  - 

140  - 

141  - 

142  -  C 

143  -  C 

144  - 

145  - 

146  - 

147  -  C 

148  -  C 

149  - 

150  - 

151  - 

152  - 

153  - 

154  - 

155  - 

156  - 

157  - 

158  - 

159  -  C 

160  -  C 

161  - 
162  - 

163  - 

164  - 

165  - 

166  - 

167  - 

168  - 

169  - 

170  - 

171  - 

172  -  C 

173  -  C 

174  - 

175  - 

176  - 

177  - 

178  - 


CALL  D1MWH(DATA,MD1,MD2) 

CALL  FLAGZ(-999.0) 

CALL  NOLABL 
DEL=CMPPT/2.54 
AXL=LPHALF*DEL 
SAMPHR= SAMP  SEC/ 3600. 

OFTOT=l./(2.»SAMPHR) 

DI STIC=AXL* FREQTIC/DFTOT 
TRYLEN=AXL/DIST  IC 
ALEN=tl«-lNT  (TRYLEN)  )*OISTIC 

IF  (A8S(ALEN-TRYLEN).LE.0.1)  AL  EN=ALEN*-DI  ST  IC 
AXLEN=2.*ALEN 

FIRSTV=-(ALEN/D ISTI C ) ♦FREQT IC 
PLOT  TITLE  AND  LABELS 
EXPLOT=AXLENH. 

WYEPL0T  =  28. 

IF  CNVEC.EQ.l)  GO  TO  100 

CALL  SYMBOL<EXPLOT*-4.3,WYEPLOT-7.9,0.420, 
$‘CROSS  ROTARY  BICOHERENCE • ,-90. ,24) 

GO  TO  12  0 

100  CALL  SYMBOL(EXPLOT*-4.3,WYEPLOT-8.2,0.420, 
$'AUTO  ROTARY  BICOHERENCE* ,-90. , 23 ) 

120  CONTINUE 


DO  130  1=1,6 

READ  tlSTOREl)  I  I  NAMES ( J ) , J  =  34I -2 ,3*1 ) , I V AR  11  ) 
130  CONTINUE 


READ  (iSTOREl)  MF 

READ  (ISTOREl)  LABL 

IF  (IBUOY.EQ.O)  GO  TO  150 

CALL  S YMBOL  (EXPLOT ♦•3.4,WYEPL0T- 1.2,  0.210, 
$*COMPONENTS  OF  VECTOR  S ER IE  S' ,-90 . , 27) 
CALL  SYMBOL(EXPLOT*-3.0,WYEPL0T-l.l,0.17  5, 
$*ORIGINAL  FILE  NAME S • ,-90. , 20 ) 

CALL  SYMBOL  (EXPLOT«-3.0,  WYEPLOT-5. 2,  0.175, 
S'VARIABLE  NUMBERS *, -90. , 17) 
IFREQ(1)=4HFREQ  ;  I  FREQ ( 2 )  =  4HUE NC 


DO  140  1=1,3 

IF  (l.EQ.l)  IFREQ(31=4HY  1:  ;  GO  TO  137 
IF  (I.EQ.2)  IFREQ{3)=4HY  2:  ;  GO  TO  137 
IFREQ(3)=4HY  3: 

137  CALL  SYMBOL(EXPLOT*-2.7-0.6*(I-l),WYEPLOT,0.14,IFREQ, 
$-90., 12) 

CALL  SYMB0L{EXPL0T«-2.7-0.6*  I  I-l  )  ,  KYE  PLOT-2. 0 , 0.  14, 
$INAMES(6»I-5)  ,-90.,  12) 

CALL  SYMB0L(EXPL0T«-2.45-0.6*(  I-l)  ,WYEPL0T-2.0,0.i4, 
$INAMES(6*I-2) ,-90., 12) 

140  CONTINUE 


DO  145  1=1,3 
FVAR=FLOAT( IVARI 2*1-1 )) 

CALL  NUMBER(EXPLOT«-2.7-0.6*(  I-l  )  ,  WYEPLO  T-6. 6, 0.  14,FVAR, 
$-90., -1) 

CALL  NUMBER(EXPLOT4-2.45-0.6*(  I-l),WYEPLDT-6.6,0. 14,FVAR, 
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179  - 

180  - 

181  -  C 

182  -  C 

183  - 
18^  - 

185  - 

186  - 

187  - 

188  -  C 

189  -  C 
1,90  - 
19  1  - 

192  - 

193  - 
19A  - 

195  - 

196  - 

197  - 

198  -  C 

199  -  C 

200  - 
201  - 
202  - 

203  - 

204  - 

205  - 

206  - 

207  - 

208  - 

209  - 

210  - 
211  - 
212  - 

213  - 

214  - 

215  -  C 

216  - 

217  -  C 

218  - 

219  - 

220  - 
221  - 
222  - 

223  - 

224  - 

225  - 

226  - 

22  7  - 
228  - 

229  - 

230  - 

231  - 

23  2  - 

233  - 

234  - 

235  - 

236  - 

237  - 

238  - 


$-90.,-l) 
145  CONTINUE 


150  CONTINUE 

CALL  SYMB0L(EXPL0T*3.4,WYEPL0T-g.8,0.17  5, 
$‘CONTOUR  LEVELS  AND  PERCENT  CON  FI DENCE ' f-90. t 37  I 
BIASX=BI ASY=0. 

IF  (NCONLV.GT .101  NCQNLV=10 


DO  160  I=1,NC0NLV 

IF  (I. £0.6)  BIASX=0.  ;  0 1  AS Y=BI AS Y-3.0 

CALL  NUMBER  (EXPL0T*-2.9«-BIASXtWYEPL0T-ll  .9+BI  ASY,0.210f 

SCONLVI I ) t-90. ,3 ) 

CALL  NUMBER(EXPL0T<-2.9<-BIASX»WYEPL0T-13.3+BlASY  t  0.210» 
SCONFLVI I )f-90. ,3) 

BIASX=BIASX-0.4 
160  CONTINUE 


CALL  SYMBOL  (EXPLOT ♦^0.4tWYEPL0T-9.2t0.210»  lOENTl » -90  .  f  36  ) 
CALL  SYM BOL( EXPLOT, WYEPLOT-9. 2, 0.210, IDeNT2, -90., 36) 

IF  I1MF.NE.21 ).0R.(  IFOURIER.EQ.O)  )  GO  TO  170 
CALL  SYM80LIEXPL0T*-3.4,WY£PL0T-21.4,0.1  75, 

S'PRUCESSING  HISTORY* ,-90. ,18) 

CALL  SyMB0L(EXPL0T<-2.9,WYEPL0T-18.8,0.i75,LABL,-90.  ,36) 
CALL  SYMB0L(EXPL0T<-2.4,WYEPL0T-18.8,0.175,LABL(  10)  ,-90.  , 
$48) 

CALL  SYMB0L(EXPL0TH.9,WYEPLaT-18.8,0.175,LABL(22),  -90.  , 
$48) 

170  CONTINUE 

CALL  TODAY!  ICLK  ) 

CALL  SYMBOL (EXPLOT* 1 . 0 , WYEPLQT-22.0 , 0. 1 75 , 

$*TIME  OF  PLOT:* ,-90.  ,13) 

CALL  SYMBOL (EXPL0T*0.7,WYEPLOT-21.6,0.175,ICLK,-9O. ,16) 
LABELLING  COMPLETED.  ESTABLISH  NEW  ORIGIN. 

CALL  PLOT  (0.,  14.5«-AXL,-3) 

BOUNDARIES  OF  DOMAIN,  PLUS  X  AND  Y  AXES  (UNLABELLED) 

CALL  PLOT (AXL ,-AXL, 3) 

CALL  PLOT (0.5*AXL,-0.5*AXL,2) 

CALL  PLOT (AXL, 0.  ,2) 

CALL  PL0T(2.*AXL,0. ,2) 

CALL  PL0T(0.,-2.*AXL,2) 

CALL  PLOT (AXL , -2. ♦AXL, 2  ) 

CALL  PL0T(1.5*AXL,-1.5*AXL,2) 

CALL  PL0T(AXL,-AXL,2) 

OFFSET=ALEN-AXL 

CALL  AXWJSI AXL, OFFSET,*  * ,- 1 , AX LEN, -90. ,0 . , 1 . , 0  I ST  I C , 

$— 1,0,0, .12, .7, .0001, .14) 

CALL  AXWJS!-OFFSET,-AXL, •  * , 1 , AXLEN ,0. , 0. , 1 . , DI ST IC , 

$—1,0,0, .12, .7, .0001, .14) 

IF  (ISW.NE.3)  GO  TO  180 
CALL  PLOT (2. ♦AXL, 0. ,3) 

CALL  PLOT  12. ♦AXL, -AXL, 2  ) 

CALL  PL0T(1.5^AXL,-1.54AXL,2) 

CALL  PLOT (0. , -2. ♦AXL, 3) 

CALL  PLOT  (0. ,-AXL, 2) 

CALL  PLOT(0.5^AXL,-0.5*AXL,2) 

180  CONTINUE 
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239 

240 

241 

242 

243 

244 

245 

246 

247 

248 

249 

250 

251 

252 

253 

254 

255 

256 

257 

258 

259 

260 
261 
262 

263 

264 

265 

266 

267 

268 

269 

270 

271 

272 

273 

274 

275 

276 

277 

278 

279 

280 
281 
282 

283 

284 

285 

286 

287 

288 

289 

290 

291 

292 

293 

294 

295 

296 

297 

298 


C  LABELLED  BOUNDARIES  OF  PLOT 

CALL  AXWJSI-OFFSET, OFFSET, •FREQ2  (CPH )  •  , 1 1 , AXLEN, 0. , 
$FIRSTV,FREQTIC,DIST IC , NDECPL , 0, 0 , 0. 12,0. 7,0.14, 0. 14 ) 

CALL  AXWJSI2. ♦AXLfOFFSET, OFFSET, 'FREQl  ( CPH )', 1 1 , AXLEN, 
$-90.,FIRSTV,FREQT IC ,D IS T IC , NDEC PL ,0 , 0 ,0 . 12 , 0. 7, 0. 14 , 0 . 1 4 ) 
CALL  AXrtJSI-OFFSET, OFFSET, 'FREQl  (CPH ) ' , - 1 I , AXL EN , -90. , 
SFIRSTV,FREQTIC, DIST IC , NDECPL , 0, 0, 0. 12 ,0 . 7 ,0 . 14, 0 . 14 ) 

CALL  AXWJSC-OFFSET,-2.*AXL-OFFSET, •FREQ2  (CPH)', -11, 
$AXLEN,0. ,FIRSTV,FREQT1C , D IS T IC , NDEC PL , 0 , 0 , 0 . 1 2 , 0.7,0.14, 
$0.14) 

C  BEGIN  CONTOURING 

C  POSITIVE  SUM  FREQUENCIES  FOR  /Wl/  >  /W2/ 

CALL  GRIDIO.,-AXL-DEL,DEL,-DEL ) 

CALL  WHCNTR  (DAT  A,  1 ,  LP34  4-1  ,1  ,  LPHALF,  NCONLV  ,CONLV  ) 

IPASS=2 
GO  TO  30 
200  CONTINUE 

C  NEGATIVE  SUM  FREQUENCIES  FOR  /Wl/  >  /W2/ 

CALL  GRID(0.5*AXL,0. ,DEL,-DEL) 

CALL  WHCNTR (D AT  A, 1,LP34  +  I,1, LPHALF, NCONLV, CONLV) 

IPASS=1  ;  KPASS=2 
IF  (ISW.NE.3)  GO  TO  500 
GO  TO  30 
300  CONTINUE 

C  POSITIVE  SUM  FREQUENCIES  FOR  /Wl/  <  /W2/ 

CALL  DIMWHI XDATA,MD2,MD1) 

CALL  GRI0(AXL,O.,DEL,-O£L) 

CALL  WHCNTR  (XDATA,  1  ,LPHALF  +  1,  l,LP34fl,NC0NLV,C0NLV') 
IPASS=2 
GO  TO  30 
400  CONTINUE 

C  NEGATIVE  SUM  FREQUENCIES  FOR  /Wl/  <  /W2/ 

CALL  GRIO(0.,-0.5*AXL,DEL,-DEL) 

CALL  WHCNTR  (XDA TA,  1  ,LPHALF<-1,1,LP34<-1,NC0NLV,C0NLV) 


500  CONTINUE 

CALL  PL0T(0.,0.,999) 

STOP  'NORMAL  PROGRAM  COMPLETION* 


SUBROUTINE  BIASdP) 


C  INTERNAL  SUBROUTINE  FOR  PROGRAM  RBPLOT 
4  GO  TO  (6,8) ,IP 

6  GO  TO  (10,15,15,10,20,25,25,20,10,15,15,10,25,30,30,35), 
$ISQ 

a  GO  TO  (30,40,40,30,35,50,50,35,30,40,40,30,50,60,60,20), 
$ISQ 

10  CALL  ASN(  I8IASR, 1 )  ;  GO  TO  65 

15  CALL  ASN(IBIASR,2)  ;  GO  TO  65 

20  CALL  ASN(  IBIASR,3)  i  GO  TO  65 

25  CALL  ASN( IBIASR,4)  ;  GO  TO  65 

30  CALL  ASN(  IBIASR,5)  ;  GO  TO  65 

35  CALL  ASN(  IBIASR,6)  ;  GO  TO  65 

40  CALL  ASN(  IBIASR,7)  ;  GO  TO  65 

50  CALL  ASN (  IBIASR ,8  )  ;  GO  TO  65 

60  CALL  ASN(  IBIASR, 9)  ;  GO  TO  65 

65  GO  TO  (67,68) ,I P 

67  GO  TO  (70,70,75,75,75,75,80,80,80,80,85,85,85,85,80,85), 
$ISQ 

68  GO  TO  (85,85,80,80,80,80,75,75,75,75,70,70,70,70,75,70), 
$1SQ 
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299 

300 

301 

302 

303 
30A 

305 

306 

307 

308 

309 

310 

311 

312 

313 

314 

315 

316 

317 


70 

CALL 

ASN(  IB1ASC,6) 

;  RETURN 

75 

CALL 

ASN(  IBIASC,5) 

;  RETURN 

80 

CALL 

ASN(  IBIASC,4) 

;  RETURN 

85 

CALL 

ASN( IBIASC,2 ) 

;  RETURN 

90 

RETURN 

SUBROUTINE  ASN( 18,1 S) 

5  GO  TO  (10,20,30,40,  50,60,70,80,90) ,  IS 


10  IB  =  LPHALF*-1  ;  RETURN 

20  IB=LP38  ;  RETURN 

30  IB  =  LP58«-1  ;  RETURN 

40  IB=LPQU  ;  RETURN 

50  IB=LPATHE  ;  RETURN 

60  18=0  ;  RETURN 

70  I8=LPQU«-l  ;  RETURN 

80  IB=LP30*-1  ;  RETURN 

90  IB=LPHALF>1  ;  RETURN 

95  RETURN 
END 
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